我每天都会将数据输入到名为“Sample Data”的工作簿中。我需要将相同的数据复制并粘贴到文件夹(名为Test)中的多个工作簿中。我还需要保存并关闭所有这些已粘贴数据的文件。
为了澄清,我手动将数据输入到工作簿“Sample Data.xlsx”中,我希望将这些数据复制到Test文件夹中保存的多个工作簿中。理想情况下,我不想打开和关闭所有这些文件,因为它们会减慢我的计算机速度,但在我看来,除此之外别无选择 - 即复制粘贴&保存这些新数据我需要打开和关闭所有100个文件。
更新:这是修改后的代码,感谢@Krishna
Sub Copydate()
Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
Path = ("/Users/devanshiruparel/Desktop/IFA Internship/Test")
FileName = Dir(Path & "\*.xlsx", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
Workbooks("Sample Data.xlsx").Sheets("Sheet1").Range("C5:O17").Copy
ActiveSheet.Cells(1, 1).PasteSpecial
Next WS
Wkb.Save
Wkb.Close True
FileName = Dir(Path, vbNormal)
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
答案 0 :(得分:0)
不要将Sample文件和其他所需文件保存在同一文件夹中
Sub Copydate()
Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
Path = 'paste the folder path here
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
'Change below file address as per your requirement
Workbooks("Sample Data.xlsx").Sheets("Sheet1").Range("A9:A11").Copy
ActiveSheet.Cells(1, 1).PasteSpecial
Next WS
Wkb.Save
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
答案 1 :(得分:0)
不,你不需要在运行宏时打开文件,宏会自动执行。请提供您的电子邮件ID,我会根据您的要求为您提供excel宏文件。
在您编辑的代码中,您没有正确地给出路径...将其更改为如下(使用驱动器名称)
" C:\ Users \ devanshiruparel \ Desktop \ IFA Internship \ Test"