You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

编写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), replace mainWorkbook.Sheets(1) with mainWorkbook.Sheets("YourTargetSheetName") everywhere it appears.
  • Paste Options: The code uses xlPasteValuesAndNumberFormats to keep values and number formatting. If you want to copy everything (including cell colors, borders), change this to xlPasteAll.
  • How to Run:
    1. Open your Autos workbook.
    2. Press Alt + F11 to open the VBA Editor.
    3. Right-click your workbook in the Project pane > Insert > Module.
    4. Paste the code into the new module.
    5. Press Alt + F8, select CopyAutoDataHorizontally, and click Run.
    6. Select all the workbooks with the Auto1 sheet when prompted.

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

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.05.22 09:46:36