VBA: Filter worksheet 2 criteria paste some visible cells in multiple columns in activeworksheet

[Kthom019]

I reviewed message posted in the forum and cannot find any to assist with my code below.

The Data set has headers and is in Range.A4:AY & lastRow

I am filtering Data sheet from Columns Q4 & AG4
The visible date should be copied into the activesheet as follows:
AQ to activesheet Range. B2
AR to activesheet Range'D2 etc, as per below
The code debugs when it tries to select visible cells and copy. Please review and let me know where I am going wrong, appreciate it.


Code:
Sub CopyH()

Dim ws1 As Worksheet, ws2 As Worksheet, LastRow As Long

Set ws1 = ThisWorkbook.Sheets("Data")
Set ws2 = ActiveSheet
LastRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row

With ws1
'set your filter
.Range("A4").AutoFilter Field:=17, Criteria1:=InputBox("BU")
.Range("A4").AutoFilter Field:=33, Criteria1:="To End" 'set your filter

'copy the visible cells in each column from row 5
'paste into copied range
.Range("AQ5").Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("B2")
.Range("AR5").Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("D2")
.Range("AS5").Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("E2")
.Range("AT5").Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("F2")
.Range("AU5").Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("G2")
.Range("AV5").Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("H2")
.Range("AW5").Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("I2")
.Range("AX5").Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("J2")
.Range("AY5").Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("K2")

.Range("A1").AutoFilter 'clear the filter

End With

MsgBox "Completed"

End Sub

 

[Kthom019]

I found my error and corrected it 'LastRow' was not inserted correctly in the copy range. Code below works perfectly.

Code:
Sub CopyH()

Dim ws1 As Worksheet, ws2 As Worksheet, LastRow As Long
Set ws1 = ThisWorkbook.Sheets("Data")
Set ws2 = ActiveSheet
LastRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row

With ws1
'set your filter
.Range("A4").AutoFilter Field:=17, Criteria1:=InputBox("BU")
.Range("A4").AutoFilter Field:=33, Criteria1:="To End" 'set your filter

'copy the visible cells in each column from row 5
'paste into copied range
.Range("AQ5").Resize (LastRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("B2")
.Range("AR5").Resize (LastRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("D2")
.Range("AS5").Resize (LastRow - 11).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("E2")
.Range("AT5").Resize (LastRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("F2")
.Range("AU5").Resize (LastRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("G2")
.Range("AV5").Resize (LastRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("H2")
.Range("AW5").Resize (LastRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("I2")
.Range("AX5").Resize (LastRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("J2")
.Range("AY5").Resize (LastRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("K2")

.Range("A4").AutoFilter 'clear the filter
End With
MsgBox "Completed yah!"
End Sub