Question

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

我很抱歉我的代码格式。我在这里发布时不知道如何修复它。

这是我的代码：

Option Explicit

Const FOLDER_PATH = "D:\Programming\VBA\Linh\CARD DELIVERY\New 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列A中的过滤数据从第2行向下隐藏

使用Autofilter后，将数据从多个工作簿复制到一个工作簿

1 个答案: