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.
Thanks
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
Thanks
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...
...with this....
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.
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
...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
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.
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?
ASKER
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...
...with this...
Use Macro2 (it's quicker without the Select statements) and replace this line...
Worksheets("sh1") .Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues
...with this...
Worksheets("sh1") .Range("A" & Lastrow + 1).PasteSpecial Paste:=xlPasteValues
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
it is also changing the headings in sh1.Is it possible to stop doing that?
Thanks
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?
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
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.
Surah79, if this question has been solved, please accept the appropriate comment/s as answer.
ASKER
thanks a lot
Open in new window
...use this....
Open in new window