使用VBA将工作表从一个WB复制到另一个WB，而不打开目的地WB

Question

我是VBA的新手，并试图自动化工作簿的更新。我有一个源工作簿A和一个目标工作簿B。两者都有一个叫做滚动摘要的工作表。我希望用户在A中更新此工作表，并单击“更新”按钮，该按钮将运行我的宏。此宏应自动更新工作簿B中的工作表，而不打开工作簿B。

我正在尝试这段代码，但它不起作用，并给出了一个错误：

Dim wkb1 As Workbook
Dim sht1 As Range
Dim wkb2 As Workbook
Dim sht2 As Range

Set wkb1 = ActiveWorkbook
Set wkb2 = Workbooks.Open("B.xlsx")
Set sht1 = wkb1.Worksheets("Roll Out Summary") <Getting error here>
Set sht2 = wkb2.Sheets("Roll Out Summary")

sht1.Cells.Select
Selection.Copy
Windows("B.xlsx").Activate
sht2.Cells.Select
Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False

Answer 1

sht1和sht2应该声明为Worksheet。至于在不打开工作簿的情况下更新工作簿，可以这样做，但需要一种不同的方法。为了使它看起来像是没有打开工作簿，可以打开/关闭ScreenUpdating。

试试这个：

Dim wkb1 As Workbook
Dim sht1 As Worksheet
Dim wkb2 As Workbook
Dim sht2 As Worksheet

Application.ScreenUpdating = False

Set wkb1 = ThisWorkbook
Set wkb2 = Workbooks.Open("B.xlsx")
Set sht1 = wkb1.Sheets("Roll Out Summary")
Set sht2 = wkb2.Sheets("Roll Out Summary")

sht1.Cells.Copy
sht2.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
wkb2.Close True

Application.ScreenUpdating = True

Answer 2

用这个-这个对我有用

Sub GetData()
Dim lRow As Long
Dim lCol As Long
 lRow = ThisWorkbook.Sheets("Master").Cells()(Rows.Count, 1).End(xlUp).Row
 lCol = ThisWorkbook.Sheets("Master").Cells()(1, Columns.Count).End(xlToLeft).Column
 If Sheets("Master").Cells(2, 1) <> "" Then

 ThisWorkbook.Sheets("Master").Range("A2:X" & lRow).Clear
 'Range(Cells(2, 1), Cells(lRow, lCol)).Select
 'Selection.Clear
 MsgBox "Creating Updated Master Data", vbSystemModal, "Information"
 End If
 'MsgBox ("No data Found")
 'End Sub

cell_value = Sheets("Monthly Summary").Cells(1, 4)
If cell_value = "" Then
Filename = InputBox("No Such File Found,Enter File Path Manually", "Bad Request")
Else
MsgBox (cell_value)
Path = "D:\" & cell_value & "\"
Filename = Dir(Path & "*.xlsx")
If Filename = "" Then

Filename = InputBox("No Such File Found,Enter File Path Manually", "Bad Request")
Else
  Do While Filename <> ""

  On Error GoTo ErrHandler
    Application.ScreenUpdating = False

  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     ActiveWorkbook.Sheets("CCA Download").Activate
     LastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row

Range("A2:X" & LastRow).Select

Selection.Copy

ThisWorkbook.Sheets("Master").Activate

LastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Select

'Required after first paste to shift active cell down one
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop

ActiveCell.Offset(0, -3).Select
Selection.PasteSpecial xlPasteValues

     Workbooks(Filename).Close
     Filename = Dir()
  Loop
  End If
  End If
  Sheets("Monthly Summary").Activate
  'Sheets("Monthly Summary").RefreshAll
  Dim pvtTbl As PivotTable
For Each pvtTbl In ActiveSheet.PivotTables
pvtTbl.RefreshTable
Next
  'Sheets("Monthly Sumaary").Refresh
  MsgBox "Monthly MIS Created Sucessfully", vbOKCancel + vbDefaultButton1, "Sucessful"
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
  End Sub