循环遍历文件夹中的工作簿
循环遍历文件夹中的工作簿
提问于 2020-03-27 13:50:18
我正在尝试从文件夹中的所有工作簿中复制某些单元格。下面的代码只循环第一个文件。新手到VBA。欢迎任何帮助。
提前感谢
Sub Get_Data()
Dim Directory As String
Dim Filename As String
Dim Sheet As Worksheet
Dim i As Integer
Dim j As Integer
Dim wsDest As Workbook
Application.ScreenUpdating = False
Set wsDest = ThisWorkbook
Directory = "C:\Users\dchandarman\Desktop\Current Season\Weekly Production SA\"
Filename = Dir(Directory & "*.xls")
Do While Filename <> ""
MsgBox Filename
Workbooks.Open (Directory & Filename)
Application.ActiveWorkbook.Worksheets("Exec").Range("C21:Y21").Copy
wsDest.Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats
Application.ActiveWorkbook.Worksheets("Exec").Range("C23:Y23").Copy
wsDest.Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats
Application.Workbooks(Filename).Worksheets("Exec").Range("C31:Y32").Copy
wsDest.Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats
i = 0
Do Until i = 4
Application.Workbooks(Filename).Worksheets("Exec").Range("D7").Copy
wsDest.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats
i = i + 1
Loop
Application.Workbooks(Filename).Close Savechanges:=False
Loop
End Sub回答 1
Stack Overflow用户
回答已采纳
发布于 2020-03-27 15:55:48
您可以复制/粘贴非连续范围。
Sub Get_Data2()
Const Directory = "C:\Users\dchandarman\Desktop\Current Season\Weekly Production SA\"
Dim Filename As String
Dim wsDest As Worksheet, rngDest As Range
Dim wbSrc As Workbook, wsSrc As Worksheet
Set wsDest = ThisWorkbook.Sheets("Sheet1")
Filename = Dir(Directory & "*.xls")
Do While Filename <> ""
MsgBox Filename
Set wbSrc = Workbooks.Open(Directory & Filename)
Set wsSrc = wbSrc.Worksheets("Exec")
wsSrc.Range("C21:Y21,C23:Y23,C31:Y32").Copy
Set rngDest = wsDest.Cells(Rows.Count, "B").End(xlUp).Offset(1)
rngDest.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
wsSrc.Range("D7").Copy
rngDest.Offset(0, -1).Resize(4, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
wbSrc.Close
Filename = Dir
Loop
MsgBox "Done"
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/60887390
复制相关文章
相似问题
腾讯云开发者
