Link to home
Start Free TrialLog in
Avatar of surah79
surah79

asked on

Excel VBA Code

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
Avatar of Wayne Taylor (webtubbs)
Wayne Taylor (webtubbs)
Flag of Australia image

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

Avatar of surah79
surah79

ASKER

It didn't copy the data to the sh1
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.
Avatar of surah79

ASKER

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.
Are you able to post your workbook?
Avatar of surah79

ASKER

it also replace the headers also.

Thanks
Copy-of-test-.xlsm
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

ASKER CERTIFIED SOLUTION
Avatar of Wayne Taylor (webtubbs)
Wayne Taylor (webtubbs)
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of surah79

ASKER

it is also changing the headings in sh1.Is it possible to stop doing that?

Thanks
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?
Avatar of surah79

ASKER

thanks a lot all good.
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

Avatar of surah79

ASKER

awesome thanks a lot
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.
Avatar of surah79

ASKER

thanks a lot