使用自动筛选后，将数据从多个工作簿复制到一个工作簿

Question

使用过滤器后，我正在尝试将数据从多个WB复制到一个WB。我可以选择复制范围，但我不知道如何在不覆盖数据的情况下将它们粘贴到目标 WB。

我很抱歉我的代码格式。当我在这里发布它时，我不知道如何解决它。

这是我的代码：

Option Explicit
Const FOLDER_PATH = "D:ProgrammingVBALinhCARD DELIVERYNew folder"  'REMEMBER END BACKSLASH
Sub ImportWorksheets()
'=============================================
'Process all Excel files in specified folder
'=============================================
Dim sFile As String           'file to process
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rowTarget As Long         'output row
Dim rowCount As Long
rowTarget = 2
'check the folder exists
If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If
'reset application settings in event of error
On Error GoTo errHandler
Application.ScreenUpdating = False
'set up the target worksheet
Set wsTarget = Sheets("Sheet1")
'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xls*")
Do Until sFile = ""
'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
Set wsSource = wbSource.Worksheets(1) 'EDIT IF NECESSARY
wsSource.Range("A2", Range("P" & Rows.Count).End(xlUp)).AutoFilter Field:=12, Criteria1:="Phát thành công"
wsSource.Range("I2", Range("I" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
rowCount = wsSource.Range("I2", Range("I" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells.Count
'import the data
With wsTarget
End With
'close the source workbook, increment the output row and get the next file
wbSource.Close SaveChanges:=False
rowTarget = rowTarget + 1
sFile = Dir()
Loop
errHandler:
On Error Resume Next
Application.ScreenUpdating = True
'tidy up
Set wsSource = Nothing
Set wbSource = Nothing
Set wsTarget = Nothing
End Sub
Private Function FileFolderExists(strPath As String) As Boolean
If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

Answer 1

只需添加：

'import the data
wsTarget
.cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial
End With

继续将过滤后的数据粘贴到wsTarget从第 2 行向下的 A 列

中