** PLEASE DO NOT REPLY TO THIS MESSAGE **
A common problem because the usual use of .End(xlup) to find the bottom row does not work here. Copy & Paste saves a lot of complicated code.
A common problem because the usual use of .End(xlup) to find the bottom row does not work here. Copy & Paste saves a lot of complicated code.
Code:
'===========================================================================
'- MACRO TO COPY/PASTE AUTOFILTERED DATA TO BOTTOM OF ANOTHER WORKSHEET
'- Assumes autofiltered table header in row 1.
'- Choose a column containing no blanks to set FromLastRow
'- compare code for setting FromLastRow and ToLastRow
'- Brian Baulsom August 2005
'===========================================================================
Sub test()
Dim FromSheet As Worksheet ' currently active sheet containing table
Dim FromColumns As Integer ' number of columns in table
Dim FromLastRow As Long ' automatic count. no blanks here
Dim CopyRange As Range ' range to copy. automatically set
Dim ToSheet As Worksheet ' amend name below
Dim ToLastRow As Long ' automatic count
'------------------------------------------------------------------------
'- Fromsheet : get autofiltered data
'------------------------------------------------------------------------
Set FromSheet = ActiveSheet
With FromSheet
FromColumns = .Range("A1").End(xlToRight).Column
FromLastRow = .Range("A1").End(xlDown).Row 'no blanks in this column
'- set copy range from row 2 down
Set CopyRange = .Range(Cells(2, 1), Cells(FromLastRow, FromColumns))
End With
CopyRange.Copy
'-------------------------------------------------------------------------
'- ToSheet : paste data
'- NB. Change its name below as appropriate
'-------------------------------------------------------------------------
Set ToSheet = Worksheets("Sheet2")
ToLastRow = ToSheet.Range("A65536").End(xlUp).Row + 1
ToSheet.Cells(ToLastRow, 1).PasteSpecial Paste:=xlPasteValues
ToSheet.Activate ' to show copied data
'-------------------------------------------------------------------------
Application.CutCopyMode = False ' cancel selection
End Sub