excel - 如何将一个文件夹中多个excel工作簿上除工作表1和2之外的所有工作表复制到另一个工作簿中
问题描述
如果有人能帮我解决这个我找不到解决方案的问题,我真的很感激(对不起我的英语不好)。
所以我在一个文件夹中有多个excel。其中的每个 excel 都有相同的格式,第一张表用于参考每张表,第二张表用于合并数据,第三张表用于合并数据。文件夹中的每个 excel 都有不同数量的工作表。
我想要做的是我想将范围 A27:AJ500 中的数据从第三张表开始复制到之后的每张表中,复制到 sheet1 中的另一个新工作簿中,并将其从单元格 A27 开始一遍又一遍地粘贴到底部并为每个 excel 循环在文件夹中。
我还没有足够的能力编写自己的脚本,但我设法理解了一些并将其组合到这个脚本中。
Sub Download_Data()
Path = "C:\Users\ASUS\Desktop\Done\"
Filename = Dir(Path & "*.xlsm")
'to open every excel in my folder
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True '--> i only managed to do it right till here
'supposed to copy range in every sheet of excel in my folder into different workbook
For Each ws In thiswoorkbook.Worksheets '--> i try write this code but i am confused to do what i want from here and i know this code is nowhere near true
With ws
If .Name <> "GABUNGAN" Then
range("A27:AJ500").Select
Selection.copy
Workbooks("Tes.xlsm").range("A27").PasteSpecial Paste:=xlPasteValues
End If
End With
Next ws
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.Goto ActiveWorkbook.Sheets("sheet1").range("A1")
End Sub
我一直在寻找代码,不仅无法将其自定义为该代码,而且我无法理解代码中有什么问题,因此我写了这个问题。任何帮助将不胜感激,在此先感谢您的关注,祝您平安无事。
解决方案
试试这个:(经过测试)
Dim sourcewb As Workbook
Dim destwb As Workbook
Dim y As Long
Dim ws As Worksheet
Dim strPath As String, strFilename As String
strPath = "C:\Users\ASUS\Desktop\Done\"
strFilename = Dir(strPath & "*.xlsm")
y = 27
Set destwb = ThisWorkbook
Do While strFilename <> ""
Set sourcewb = Workbooks.Open(Filename:=strPath & strFilename, ReadOnly:=True)
For Each ws In sourcewb.Worksheets
With ws
If .Name <> "name of reference sheet" And .Name <> "name of consolidation sheet" Then
.Range("A27:AJ500").Copy
destwb.Worksheets("sheet1").Range("A" & y).PasteSpecial Paste:=xlPasteValues
y = y + (500 - 27) + 1
End If
End With
Next ws
sourcewb.Close False
strFilename = Dir()
Loop