VBA脚本无法调用选中工作表，求实现文件选择与数据复制方案

Hey Carlos, let's work through your VBA issues step by step—we'll fix the worksheet reference problem, add flexible file/folder selection, and make your data copying reliable.

Key Issues in Your Original Code #

• You weren't explicitly referencing the selected files' worksheets (using Select/ActiveCell is unreliable and causes reference bugs)
• The pasting loop logic was broken (no clear LastRow definition, and you weren't targeting the correct destination range)
• No handling for opening the selected files to access their data

Updated Code with Two Solutions #

I've included two versions: one for selecting multiple files (your initial request) and another for auto-scanning all files in a folder (your "nice-to-have" feature).

Option 1: Multi-File Selection Dialog #

This lets users pick multiple Excel files, extracts your specified data from each, and appends it to your current workbook:

Private Sub MultiFileSelectAndCopy()
    Dim fd As Office.FileDialog
    Dim selectedFile As Variant
    Dim sourceWB As Workbook
    Dim destWS As Worksheet
    Dim nextDestRow As Long
    
    ' Set your destination worksheet (current open Excel file's target sheet)
    Set destWS = ThisWorkbook.ActiveSheet ' Or specify a sheet like ThisWorkbook.Sheets("DataSheet")
    
    ' Initialize File Dialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .AllowMultiSelect = True
        .Title = "Select Excel files to process"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xlsx;*.xls;*.xlsm" ' Restrict to Excel files for safety
        .Filters.Add "All Files", "*.*"
        
        If .Show = True Then
            ' Speed up processing by disabling screen updates
            Application.ScreenUpdating = False
            
            ' Loop through each selected file
            For Each selectedFile In .SelectedItems
                ' Open source file in read-only mode to avoid locking
                Set sourceWB = Workbooks.Open(selectedFile, ReadOnly:=True)
                
                ' Target the first worksheet of the source file (adjust if you need a specific sheet)
                With sourceWB.Sheets(1)
                    ' Apply formulas directly (no need for Select/ActiveCell!)
                    .Range("K4").FormulaR1C1 = "=LEFT(RIGHT(R[-2]C[-10],65),20)"
                    .Range("L4").FormulaR1C1 = "=R[5]C[-3]"
                    .Range("M4").FormulaR1C1 = "=R[6]C[-4]"
                    .Range("N4").FormulaR1C1 = "=R[7]C[-5]"
                    .Range("O4").FormulaR1C1 = "=R[8]C[-6]"
                    
                    ' Convert formulas to values to avoid broken links later
                    .Range("K4:O4").Value = .Range("K4:O4").Value
                    
                    ' Find the next empty row in your destination sheet
                    nextDestRow = destWS.Cells(destWS.Rows.Count, "A").End(xlUp).Row + 1
                    
                    ' Copy data to the destination
                    .Range("K4:O4").Copy destWS.Cells(nextDestRow, "A")
                End With
                
                ' Close source file without saving changes
                sourceWB.Close SaveChanges:=False
            Next selectedFile
            
            ' Re-enable screen updates
            Application.ScreenUpdating = True
            MsgBox "Data copied successfully!", vbInformation
        End If
    End With
End Sub

Option 2: Auto-Read All Files in a Folder #

This automatically processes every Excel file in a chosen folder (no manual file selection):

Private Sub FolderAutoScanAndCopy()
    Dim folderPath As String
    Dim fileName As String
    Dim sourceWB As Workbook
    Dim destWS As Worksheet
    Dim nextDestRow As Long
    
    ' Set destination worksheet
    Set destWS = ThisWorkbook.ActiveSheet ' Or specify your target sheet
    
    ' Let user select a folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the folder with Excel files"
        If .Show = True Then
            folderPath = .SelectedItems(1) & "\"
        Else
            Exit Sub ' User canceled the dialog
        End If
    End With
    
    ' Disable screen updates for speed
    Application.ScreenUpdating = False
    
    ' Loop through all Excel files in the folder
    fileName = Dir(folderPath & "*.xlsx") ' Start with .xlsx files
    Do While fileName <> ""
        Set sourceWB = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
        
        With sourceWB.Sheets(1)
            ' Same formula logic as Option 1
            .Range("K4").FormulaR1C1 = "=LEFT(RIGHT(R[-2]C[-10],65),20)"
            .Range("L4").FormulaR1C1 = "=R[5]C[-3]"
            .Range("M4").FormulaR1C1 = "=R[6]C[-4]"
            .Range("N4").FormulaR1C1 = "=R[7]C[-5]"
            .Range("O4").FormulaR1C1 = "=R[8]C[-6]"
            
            .Range("K4:O4").Value = .Range("K4:O4").Value
            
            nextDestRow = destWS.Cells(destWS.Rows.Count, "A").End(xlUp).Row + 1
            .Range("K4:O4").Copy destWS.Cells(nextDestRow, "A")
        End With
        
        sourceWB.Close SaveChanges:=False
        fileName = Dir ' Get the next file in the folder
    Loop
    
    Application.ScreenUpdating = True
    MsgBox "All folder files processed!", vbInformation
End Sub

Critical Improvements Explained #

• Explicit Worksheet References: We use sourceWB.Sheets(1) to target the exact worksheet in selected files, avoiding unreliable ActiveSheet dependencies.
• No Select/ActiveCell: These methods are slow and error-prone—we modify ranges directly without selecting anything.
• ReadOnly Mode: Prevents file locking issues and accidental edits to source files.
• Dynamic Destination Rows: nextDestRow finds the last used row in your destination sheet, so data is appended correctly without overwriting.
• Screen Updating Toggle: Makes the script run faster and avoids distracting screen flickering.

Customization Tips #

• If you need to target a specific sheet name in source files, replace sourceWB.Sheets(1) with sourceWB.Sheets("YourSheetName").
• Adjust formula ranges or destination columns if your data layout changes.
• For non-Excel files, modify the file filters in Option 1 or the Dir pattern in Option 2.

内容的提问来源于stack exchange，提问作者Carlos Saraiva