编写Excel宏:将多工作簿指定区域数据横向合并至Autos主工作簿
Solution for Horizontal Data Aggregation from Multiple Workbooks
Got it, let's fix this macro issue for you! The key problem with your previous code was likely that it kept pasting data to the same starting column every time. We need to calculate the next empty column in your main Autos workbook for each source file, so we can stack the data horizontally as you requested.
Here's a complete, tested macro that does exactly what you need:
Sub CopyAutoDataHorizontally() Dim mainWorkbook As Workbook Dim sourceWorkbook As Workbook Dim sourceSheet As Worksheet Dim nextTargetColumn As Long Dim filePicker As FileDialog Dim selectedFiles As Variant Dim fileIndex As Integer ' Set reference to your main "Autos" workbook (adjust if it's not the one holding the macro) Set mainWorkbook = ThisWorkbook ' Alternative: If Autos is already open, use Set mainWorkbook = Workbooks("Autos.xlsx") ' Let you pick multiple source workbooks Set filePicker = Application.FileDialog(msoFileDialogFilePicker) With filePicker .Title = "Select all workbooks with an Auto1 worksheet" .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls" .AllowMultiSelect = True If .Show <> -1 Then Exit Sub ' Exit if user cancels selection selectedFiles = .SelectedItems End With ' Speed up macro by turning off screen updates Application.ScreenUpdating = False ' Loop through each selected workbook For fileIndex = LBound(selectedFiles) To UBound(selectedFiles) ' Open the source workbook Set sourceWorkbook = Workbooks.Open(selectedFiles(fileIndex)) ' Check if the Auto1 sheet exists (avoid errors) On Error Resume Next Set sourceSheet = sourceWorkbook.Worksheets("Auto1") On Error GoTo 0 If Not sourceSheet Is Nothing Then ' Find the last used column in the main workbook's target sheet nextTargetColumn = mainWorkbook.Sheets(1).Cells(1, mainWorkbook.Sheets(1).Columns.Count).End(xlToLeft).Column ' Handle case where main sheet is empty (start at column 1) If nextTargetColumn = 1 And mainWorkbook.Sheets(1).Cells(1, 1).Value = "" Then nextTargetColumn = 0 End If ' Copy the specified range and paste to the next empty column sourceSheet.Range("H18:M3164").Copy mainWorkbook.Sheets(1).Cells(18, nextTargetColumn + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats ' Clear clipboard to prevent lingering copy prompts Application.CutCopyMode = False Else ' Alert if a workbook doesn't have Auto1 sheet MsgBox "Warning: " & selectedFiles(fileIndex) & " doesn't contain an Auto1 worksheet. Skipping this file." End If ' Close source workbook without saving changes sourceWorkbook.Close SaveChanges:=False Set sourceSheet = Nothing Set sourceWorkbook = Nothing Next fileIndex ' Restore screen updates Application.ScreenUpdating = True MsgBox "All valid data has been copied horizontally to your Autos workbook!", vbInformation End Sub
Key Details & Usage Tips:
- Target Sheet Adjustment: If you're pasting to a specific sheet in
Autos(not the first one), replacemainWorkbook.Sheets(1)withmainWorkbook.Sheets("YourTargetSheetName")everywhere it appears. - Paste Options: The code uses
xlPasteValuesAndNumberFormatsto keep values and number formatting. If you want to copy everything (including cell colors, borders), change this toxlPasteAll. - How to Run:
- Open your
Autosworkbook. - Press
Alt + F11to open the VBA Editor. - Right-click your workbook in the Project pane > Insert > Module.
- Paste the code into the new module.
- Press
Alt + F8, selectCopyAutoDataHorizontally, and click Run. - Select all the workbooks with the Auto1 sheet when prompted.
- Open your
This macro will paste the first workbook's data starting at columns A:F, the next starting at G:L, and so on—exactly the horizontal stacking you need.
内容的提问来源于stack exchange,提问作者Joao Brochado
相关产品推荐
相关产品推荐

