需要将更新推送到已closures的工作簿，并且遇到源范围方面的问题

正如标题所说，我试图将源工作簿中的一系列单元格的内容推送到目标（封闭）工作簿中的相同范围。 我使用下面的代码：

Option Explicit Sub UpdateAdminBook() Dim MyPath As String Dim MyFile As String Dim Wkb As Workbook Dim Cnt As Long Application.ScreenUpdating = False MyPath = "C:FILEPATH\" 'change the path accordingly If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\" MyFile = Dir(MyPath & "Administration.xlsx") Cnt = 0 Do While Len(MyFile) > 0 Cnt = Cnt + 1 Set Wkb = Workbooks.Open(MyPath & MyFile) Wkb.Worksheets("Administration").Range("D18:D37").Value = ActiveWorkbook.Sheets("Administration").Range("D18:D37") 'change the new value accordingly Wkb.Close savechanges:=True MyFile = Dir Loop If Cnt > 0 Then MsgBox "Completed...", vbExclamation Else MsgBox "No files were found!", vbExclamation End If Application.ScreenUpdating = True End Sub 

我在“ActiveWorkbook”开始时遇到了麻烦，而且我一直在收到“TRUE”或空格。 任何想法如何我可以解决这个问题？

Answer 1

当您打开工作簿时，它将成为活动工作簿，而不是原始工作簿。 改变这一点

 Dim wbSrc As Workbook Set wbSrc = ActiveWorkbook '... Do ... ' ... Set Wkb = Workbooks.Open(MyPath & MyFile) Wkb.Worksheets("Administration").Range("D18:D37").Value = wbSrc.Sheets("Administration").Range("D18:D37") 'change the new value accordingly 

Answer 2

您可以假设您的复制范围作为With - End With块中的参考

 Sub UpdateAdminBook() Dim MyPath As String Dim MyFile As String Dim Cnt As Long Application.ScreenUpdating = False MyPath = "C:FILEPATH\" 'change the path accordingly If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\" MyFile = Dir(MyPath & "Administration.xlsx") With ActiveWorkbook.Sheets("Administration").Range("D18:D37") Cnt = 0 Do While Len(MyFile) > 0 Cnt = Cnt + 1 Workbooks.Open(MyPath & MyFile).Worksheets("Administration").Range("D18:D37").Value = .Value 'change the new value accordingly ActiveWorkbook.Close savechanges:=True MyFile = Dir Loop End With If Cnt > 0 Then MsgBox "Completed...", vbExclamation Else MsgBox "No files were found!", vbExclamation End If Application.ScreenUpdating = True End Sub