[英]Copy/Paste part of Excel workbook to workbooks that are not currently open
[英]Open all Excel Workbooks in folder and copy & paste
我想一一打開文件夾中的所有 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
一些修復:
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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.