我想一个文件夹中打开所有Excel工作簿,然后将单元格B1复制到活动工作簿中。
引用对吗?
Sub CopyPaste
Const strVerzeichnis As String = "C:\Users\amke\Desktop"
Dim StrDatei As String
Const StrTyp As String = "*.xls"
Dim Dateiname As String
ThisWorkbook.Activate
Dateiname = Dir(strVerzeichnis & StrTyp)
Application.ScreenUpdating = False
Do While Dateiname <> ""
Workbooks.Open Filename:=strVerzeichnis & Dateiname
Workbooks(Filename).Worksheets("sheet1").Cells("B1").Copy _
Workbooks(ThisWorkbook).Worksheets("sheet1").Range("B1")
Loop
Application.ScreenUpdating = True
End Sub
答案 0 :(得分:0)
一些修复:
Sub CopyPaste
Const strVerzeichnis As String = "C:\Users\amke\Desktop\" 'Add trailing \
Dim StrDatei As String
Const StrTyp As String = "*.xls"
Dim Dateiname As String, rngPaste As Range
Set rngPaste = ThisWorkbook.Worksheets("sheet1").Range("B1")
Application.ScreenUpdating = False
Dateiname = Dir(strVerzeichnis & StrTyp)
Do While Dateiname <> ""
With Workbooks.Open(Filename:=strVerzeichnis & Dateiname)
.Worksheets("sheet1").Cells("B1").Copy rngPaste
Set rngPaste = rngPaste.offset(1, 0) 'next paste location
.Close False 'no save
End with
Dateiname = Dir() 'next file, if any
Loop
Application.ScreenUpdating = True
End Sub