VBA代码：从多个工作簿中提取数据并按列粘贴到表1

本代码演示如何使用VBA从多个工作簿中提取数据，并按列粘贴到同一工作簿的‘表1’中。该代码假设要复制3个工作簿的数据，每个工作簿的数据都在第一个工作表中的A1:A10单元格中。

Sub CopyData()
    Dim FilePath As String
    FilePath = 'C:\Users\Administrator\Desktop\个体户\'
    
    Dim wb As Workbook
    Dim ws As Worksheet
    Set wb = ThisWorkbook
    
    Dim i As Integer
    For i = 1 To 3 '假设要复制3个工作簿的数据
        Set ws = Workbooks.Open(FilePath & '工作簿' & i & '.xlsx').Sheets(1)
        ws.Range('A1:A10').Copy
        wb.Sheets('表1').Range('A' & (i - 1) * 11 + 1).PasteSpecial xlPasteValues, Transpose:=True
        wb.Save
        Workbooks('工作簿' & i & '.xlsx').Close SaveChanges:=False
    Next i
End Sub

代码说明：

FilePath：存储要复制的工作簿的文件夹路径。
wb：代表当前工作簿。
ws：代表每个要复制数据的工作表。
i：循环变量，用于遍历要复制的每个工作簿。
Workbooks.Open(FilePath & '工作簿' & i & '.xlsx').Sheets(1)：打开每个工作簿并获取第一个工作表。
ws.Range('A1:A10').Copy：复制每个工作簿中A1:A10单元格的数据。
wb.Sheets('表1').Range('A' & (i - 1) * 11 + 1).PasteSpecial xlPasteValues, Transpose:=True：将复制的数据粘贴到‘表1’中，并进行转置，使其按列排列。
wb.Save：保存当前工作簿。
Workbooks('工作簿' & i & '.xlsx').Close SaveChanges:=False：关闭被复制的工作簿，不保存更改。

使用说明：

将代码复制到Excel VBA 编辑器中。
将 FilePath 变量的值修改为要复制的工作簿所在的文件夹路径。
调整 For 循环中的 i 值，以匹配要复制的工作簿数量。
运行 CopyData 子程序。

注意：

代码假设所有工作簿都保存在同一个文件夹中，且文件名格式为 ‘工作簿1.xlsx’、‘工作簿2.xlsx’ 等。
代码假设要复制的数据都在每个工作簿的第一个工作表中。
代码会覆盖‘表1’中已有的数据。
确保目标工作簿中 ‘表1’ 工作表存在。

修改建议：

可以使用 InputBox 函数让用户输入要复制的工作簿数量和文件夹路径，提高代码的通用性。
可以使用 File.Exists 函数判断文件是否存在，避免出现错误。
可以使用 Application.ScreenUpdating = False 和 Application.DisplayAlerts = False 减少代码运行时的闪烁和提示信息。

希望这能帮助你从多个工作簿中提取数据并按列粘贴到‘表1’中。