使用Autofilter后将多工作簿数据合并至单一工作簿的VBA问题

Hey there! Let's fix your code so it pastes each filtered dataset below the previous one instead of overwriting. I've identified a few key issues in your original code and updated it with clear explanations:

Key Problems in the Original Code: #

• Missing paste operation: Your With wsTarget block was empty, so nothing was actually getting pasted to the target sheet.
• Unqualified range references: When using Range inside your source worksheet, you need to prefix it with wsSource. to avoid accidentally referencing the active sheet (a common source of bugs).
• Incorrect row increment: You were only adding 1 to rowTarget each time, but you need to add the number of rows you copied to move the target row down properly.
• No handling for empty filtered results: If a source workbook has no rows matching the filter, trying to copy visible cells will throw a runtime error.

Corrected Code: #

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
    Dim copyRange As Range
    
    rowTarget = 2 'Start pasting from row 2 in target sheet
    
    'Check if the folder exists
    If Not FileFolderExists(FOLDER_PATH) Then
        MsgBox "Specified folder does not exist, exiting!"
        Exit Sub
    End If
    
    'Reset application settings on error
    On Error GoTo errHandler
    Application.ScreenUpdating = False
    
    'Set up the target worksheet (use ThisWorkbook to reference the macro's workbook)
    Set wsTarget = ThisWorkbook.Sheets("Sheet1")
    
    'Loop through Excel files in the folder
    sFile = Dir(FOLDER_PATH & "*.xls*")
    Do Until sFile = ""
        'Open source file and set source worksheet
        Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
        Set wsSource = wbSource.Worksheets(1) 'EDIT IF NECESSARY
        
        'Apply autofilter (qualified all ranges with wsSource to avoid errors)
        wsSource.Range("A2:P" & wsSource.Rows.Count).AutoFilter Field:=12, Criteria1:="Phát thành công"
        
        'Define the visible range to copy (column I, starting at row 2)
        On Error Resume Next 'Temporarily ignore error if no visible cells
        Set copyRange = wsSource.Range("I2:I" & wsSource.Rows.Count).SpecialCells(xlCellTypeVisible)
        On Error GoTo errHandler 'Restore original error handling
        
        If Not copyRange Is Nothing Then 'Only proceed if there are visible cells to copy
            rowCount = copyRange.Cells.Count
            'Copy and paste directly to the target sheet (more efficient than copy/paste separately)
            copyRange.Copy wsTarget.Range("I" & rowTarget)
            
            'Update target row to next empty row after pasted data
            rowTarget = rowTarget + rowCount
        End If
        
        'Close source workbook without saving changes
        wbSource.Close SaveChanges:=False
        sFile = Dir() 'Get next file in folder
    Loop

errHandler:
    On Error Resume Next
    Application.ScreenUpdating = True
    'Tidy up object references
    Set copyRange = Nothing
    Set wsSource = Nothing
    Set wbSource = Nothing
    Set wsTarget = Nothing
    
    'Show error message if something went wrong
    If Err.Number <> 0 Then
        MsgBox "Error occurred: " & Err.Description, vbExclamation
    End If
End Sub

Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

What Changed: #

1. Qualified Range References: All Range calls for the source sheet now use wsSource. to ensure we're always referencing the correct sheet, not whatever sheet happens to be active.
2. Direct Paste: Instead of copying first then pasting, we use copyRange.Copy wsTarget.Range("I" & rowTarget) to paste directly to the target location, which is faster and cleaner.
3. Row Increment: rowTarget is updated by adding rowCount (the number of rows copied) so the next paste starts right after the last row of the previous dataset.
4. Empty Filter Handling: We check if copyRange exists before trying to copy, which prevents runtime errors when a source file has no rows matching your filter criteria.
5. ThisWorkbook Reference: Used ThisWorkbook to ensure we're targeting the workbook that contains the macro, avoiding confusion with other open workbooks.

This should now paste each filtered dataset from your source workbooks into Sheet1 of your target workbook without overwriting existing data.

内容的提问来源于stack exchange，提问作者Huỳnh Tụng