Excel VBA：将多个工作簿（具有多个工作表）中的特定单元格复制到单个工作簿_Excel_Vba

Excel VBA：将多个工作簿（具有多个工作表）中的特定单元格复制到单个工作簿

excel vba

Excel VBA：将多个工作簿（具有多个工作表）中的特定单元格复制到单个工作簿,excel,vba,Excel,Vba,希望你一切顺利。我是VBA新手。我们正努力做到以下几点：我们有多个工作簿，有7个工作表。第1页至第8页。（尽管不需要第3页至第8页）所有工作手册中所有表1的格式相同所有工作手册等中所有表2的格式相同我们想编写一个VBA代码，它将执行以下操作：在单独的Output.xlsm表中： a。复制工作簿1的表1中B2的值，将其粘贴到Output.xlsm的A1中 b。复制工作簿1第2页中的A3:F8范围，粘贴到Outputl.xlsm的B2中 c。然后循环浏览所有其他工作簿，执行与上面相同的

希望你一切顺利。我是VBA新手。我们正努力做到以下几点：

我们有多个工作簿，有7个工作表。第1页至第8页。（尽管不需要第3页至第8页）

所有工作手册中所有表1的格式相同

所有工作手册等中所有表2的格式相同

我们想编写一个VBA代码，它将执行以下操作：在单独的Output.xlsm表中：

a。复制工作簿1的表1中B2的值，将其粘贴到Output.xlsm的A1中

b。复制工作簿1第2页中的A3:F8范围，粘贴到Outputl.xlsm的B2中

c。然后循环浏览所有其他工作簿，执行与上面相同的操作，并将数据粘贴到其中在另一个下面。这是我们尝试过的代码：它实际上不起作用：

Sub ExportData_MultiFiles()
Dim wb1 As Workbook, wb2 As Workbook
Set wb1 = ThisWorkbook

Dim ws As Worksheet

Dim L As Long, x As Long
sPath = "E:\downloads\Reports\" '<< files in folder , change path as needed
sFile = Dir(sPath & "*.xls*")
Application.ScreenUpdating = False
Set ws = Sheets.Add(before:=Sheets(1))

Do While sFile <> ""
Set wb2 = Workbooks.Open(sPath & sFile)
For x = 1 To wb2.Sheets.Count

wb1.Sheets(x).Cells(1, 1).Value = wb2.Worksheets("Sheet1").Cells(2, 2).Value
wb1.Sheets(x).Cells(1, 2).Value = wb2.Worksheets("Sheet2").Range("A3:F8").Value


Next
wb2.Close False
sFile = Dir()
Loop
ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub

子导出数据\u多文件（）
将wb1设置为工作簿，将wb2设置为工作簿
设置wb1=ThisWorkbook
将ws设置为工作表
长度为L，长度为x
sPath=“E:\downloads\Reports\”由于您没有回答我的澄清问题，请尝试下一个代码。它将在同一张新添加的工作表中复制所有提到的范围。从新打开的工作簿中，范围将粘贴在第一个空行中，根据B:B列单元格计算：
Sub ExportData_MultiFiles()
 Dim wb1 As Workbook, wb2 As Workbook, Spath As String, sFile As String
 Dim lastRow As Long, ws As Worksheet

 Set wb1 = ThisWorkbook

 Spath = "E:\downloads\Reports\" '<< files in folder , change path as needed
 sFile = Dir(Spath & "*.xls*")
 Application.ScreenUpdating = False
 Set ws = wb1.sheets.Add(Before:=sheets(1))

 Do While sFile <> ""
    Set wb2 = Workbooks.Open(Spath & sFile)
    lastRow = ws.Range("B" & rows.count).End(xlUp).row + 1
    ws.Range("A" & lastRow).Resize(6, 1).value = wb2.Worksheets("Sheet1").Range("B2").value
    ws.Range("B" & lastRow).Resize(6, 6).value = wb2.Worksheets("Sheet2").Range("A3:F8").value

    wb2.Close False
    sFile = Dir()
 Loop
 ActiveWorkbook.Save
 Application.ScreenUpdating = True
End Sub

子导出数据\u多文件（）
将wb1设置为工作簿，将wb2设置为工作簿，将Spath设置为字符串，将sFile设置为字符串
将最后一行调整为长，ws为工作表
设置wb1=ThisWorkbook
Spath=“E:\downloads\Reports\”，因此，您需要从Spath
文件夹的所有工作簿中复制wb1
工作簿中的“Sheet1”和“Sheet2”。现在，还不太清楚的是下一个问题：“输出的A1.xlsm”还不够。你必须告诉我们哪些工作表。是否要从“Sheet1”（wb
工作簿）范围“A1”中的每个“Sheet1”（范围“A2”）进行复制？从“Sheet2”到相同的“Sheet1”或“Sheet2”？那么，如果A:A列中的所有新记录将一个接一个地完成，那么“A3:F8”范围应如何继续？首先，在哪个工作表中粘贴，然后，下一个工作簿范围应粘贴在“B:B”中最后一行之后？我尝试查找共享工作簿，但没有任何内容与您上面的解释相匹配。。。我没有看到任何工作簿示例有8行，我可以看到“Output.xlsm”（只有一张工作表）在许多行中有“abc”、“xyz”。。。因为您说过A3:F8将粘贴在B2中，所以所有第一行上都有记录。是否已经存在列标题？我无法开始准备一段代码，因为我不太明白您需要什么…@FaneDuru:非常感谢您的消息。@FaneDuru:我分享了以下几点：1。每个工作簿都有一张工作表1和一张工作表2。2.从每个工作簿的Sheet1中，单元格A2中的值必须粘贴到Output.xlsm的A2:A7中。3.从每个工作簿的Sheet2中，必须将A3:F8范围内的值粘贴到输出中。xlsm的B2:G7@FaneDuru：请看这张图片：@FaneDru:Hi FaneDru！对请看这张图片：@FaneDru:您的代码工作得非常完美，正如预期的那样。这对我们所有的新手都有很大帮助。非常感谢你。请分享如何制作abc和xyz，就像我在上面分享的图片一样。@Ashok:好的。我将修改代码，将“Sheet1”的“B2”值复制到下六行。我看到你的链接有数据，我问了这个问题。当您提出问题时，强烈建议您不时检查。否则，如果问题不清楚，还有数百个其他问题需要回答，很少有人会把时间浪费在不清楚的项目上…@FaneDru:是的，当然！我会这样做的。谢谢。@Ashok:很高兴我能帮上忙！但我们在这里，当有人回答我们的问题时，勾选左侧代码侧复选框，以使其成为可接受的答案。这样，其他搜索类似问题的人就会知道代码是有效的。。。