[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Excel VBA Code

Posted on 2016-09-22
15
Medium Priority
?
79 Views
Last Modified: 2016-09-25
I am trying to copy the data from one sheet to another using vba. But it copying and pasting the data with the header. Is there any way it doesn't copy the header just copy the data with the selection and paste it.

Sub Macro1()
'
' Macro1 Macro
'

'
Worksheets("Westpac").AutoFilterMode = False
    Dim Firstrow As Long
    Dim rng As Range
    Dim Lastrow As Long
    Dim i As Integer
    Dim j As Integer
     i = Sheets("Sheet1").Range("o4")
    
    j = 0
    
    Do Until j = i
     
    Sheets("Sh1").Select
    With ActiveSheet
        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
 
     
     
     Sheets("Westpac").Select
     With ActiveSheet
    Sheets("Westpac").Range("A1:C1").Select
    Selection.AutoFilter

    .Range("$A$1:$C$1").AutoFilter Field:=1, Criteria1:=Sheets("Sheet1").Range("m3")
    .Range("$A$1:$C$1").AutoFilter Field:=2, Criteria1:=Sheets("Sheet1").Range("n3")
   Sheets("Westpac").UsedRange.SpecialCells(xlCellTypeVisible).Copy
   
       End With
         
    Sheets("Sh1").Select
   
    Cells(Lastrow).Select
    Range("A" & Lastrow).Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        j = j + 1

    Loop
    
End Sub

Open in new window


Thanks
0
Comment
Question by:surah79
  • 7
  • 7
15 Comments
 
LVL 48

Expert Comment

by:Wayne Taylor (webtubbs)
ID: 41811739
Instead of this line....

Sheets("Westpac").UsedRange.SpecialCells(xlCellTypeVisible).Copy

Open in new window


...use this....

Intersect(Range("2:" & Rows.Count), ActiveSheet.AutoFilter.Range).Copy

Open in new window

0
 

Author Comment

by:surah79
ID: 41811745
It didn't copy the data to the sh1
0
 
LVL 48

Expert Comment

by:Wayne Taylor (webtubbs)
ID: 41811757
Your code looks like it's setting the filter on the Westpac sheet filtering columns A and B by the values in Sheet1!M3 and Sheet1!N3 respectively, then copying that data to the end of the data in the Sh1 sheet. Is that correct? I can't see why you are looping.

Perhaps replace this section of your code...

     Sheets("Westpac").Select
     With ActiveSheet
    Sheets("Westpac").Range("A1:C1").Select
    Selection.AutoFilter

    .Range("$A$1:$C$1").AutoFilter Field:=1, Criteria1:=Sheets("Sheet1").Range("m3")
    .Range("$A$1:$C$1").AutoFilter Field:=2, Criteria1:=Sheets("Sheet1").Range("n3")
   Sheets("Westpac").UsedRange.SpecialCells(xlCellTypeVisible).Copy
   
       End With
         
    Sheets("Sh1").Select
   
    Cells(Lastrow).Select
    Range("A" & Lastrow).Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Open in new window


...with this....

     With Sheets("Westpac")
        .Range("A1:C1").AutoFilter
        .Range("$A$1:$C$1").AutoFilter Field:=1, Criteria1:=Sheets("Sheet1").Range("m3")
        .Range("$A$1:$C$1").AutoFilter Field:=2, Criteria1:=Sheets("Sheet1").Range("n3")
        Intersect(.Range("2:" & Rows.Count), .AutoFilter.Range).Copy
    End With
   Worksheets("sh1") .Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues

Open in new window


If that still doesn't copy any data to sh1, then the filters are not returning any results and you'd need to look at that.
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:surah79
ID: 41811768
I can see the selection but now its not pasting anything at all...I am looping it because as the same data needs to get copied 5- 6 times so that I don't need to repeat the same data copying again and again.
0
 
LVL 48

Expert Comment

by:Wayne Taylor (webtubbs)
ID: 41811770
Are you able to post your workbook?
0
 

Author Comment

by:surah79
ID: 41811776
it also replace the headers also.

Thanks
Copy-of-test-.xlsm
0
 
LVL 48

Expert Comment

by:Wayne Taylor (webtubbs)
ID: 41811783
The only thing I can see it's doing wrong is the LastRow isn't being used correctly. You don't want it to paste at the LastRow, but the next blank row.

Use Macro2 (it's quicker without the Select statements) and replace this line...

    Worksheets("sh1") .Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues

Open in new window


...with this...

    Worksheets("sh1") .Range("A" & Lastrow + 1).PasteSpecial Paste:=xlPasteValues

Open in new window

0
 
LVL 48

Accepted Solution

by:
Wayne Taylor (webtubbs) earned 2000 total points
ID: 41811785
You can also speed it even more by using this macro instead...

Sub CopyFilteredResults()
    
    Worksheets("Westpac").AutoFilterMode = False
    With Sheets("Westpac")
        .Range("A1:C1").AutoFilter
        .Range("$A$1:$C$1").AutoFilter Field:=1, Criteria1:=Sheets("Sheet1").Range("m3")
        .Range("$A$1:$C$1").AutoFilter Field:=2, Criteria1:=Sheets("Sheet1").Range("n3")
        Intersect(.Range("2:" & Rows.Count), .AutoFilter.Range).Copy
    End With
    
    For i = 1 To Worksheets("Sheet1").Range("O4")
        Worksheets("sh1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    Next
    
End Sub

Open in new window

0
 

Author Comment

by:surah79
ID: 41811796
it is also changing the headings in sh1.Is it possible to stop doing that?

Thanks
0
 
LVL 48

Expert Comment

by:Wayne Taylor (webtubbs)
ID: 41811809
It is not changing the headers. It works fine. Are you using the latest macro I posted, or using the linked macro on the shape in Sh1?
0
 

Author Comment

by:surah79
ID: 41811815
thanks a lot all good.
0
 
LVL 22

Expert Comment

by:Roy Cox
ID: 41811941
Try this
Sub Copy_Data_Only()
    Dim rData As Range
    With Worksheets("Westpac")
        ''/// check for AutoFilter, switch on if necessary
        If Not .AutoFilterMode Then .Range("A1").AutoFilter
        ''/// filter on third column, change as required. Change criteria as necessary
        .Range("A1").AutoFilter Field:=1, Criteria1:=Sheets("Sheet1").Range("m3")
        .Range("A1").AutoFilter Field:=2, Criteria1:=Sheets("Sheet1").Range("n3")
        ''/// clear the destination sheet
        ''///         Sheets("Sh1").Range("A1").CurrentRegion.ClearContents
        ''/// copy filtered rows to sheet 2
        Set rData = .AutoFilter.Range
        ''/// remove header row
        rData.Offset(1, 0).Resize(rData.Rows.Count - 1, _
                                  rData.Columns.Count).Copy Sheets("Sh1").Cells(Rows.Count, 1).End(xlUp).Offset(1)
        ''/// delete copied rows
        ''///         .AutoFilter.Range.Offset(1).EntireRow.Delete
        ''/// remove AutoFilter
        .Range("A1").AutoFilter
    End With

Open in new window

0
 

Author Comment

by:surah79
ID: 41815159
awesome thanks a lot
0
 
LVL 48

Expert Comment

by:Wayne Taylor (webtubbs)
ID: 41815161
Roy, your code fails to copy x number of times as required.

Surah79, if this question has been solved, please accept the appropriate comment/s as answer.
0
 

Author Closing Comment

by:surah79
ID: 41815179
thanks a lot
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft's Excel has many features that most people will never need nor take advantage of.  Conditional formatting is one feature that you may find a necessity once you start using it.
Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

873 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question