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

我是VBA新手，尝试自动更新工作簿。 我有一个源工作簿A和一个目标工作簿B。 两者都有一个名为roll out summary的表 。 我想让用户在A中更新这个表格，然后点击更新button，它应该运行我的macros。 该macros应自动更新工作簿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 。 至于更新工作簿而不打开它，它可以完成，但需要一个不同的方法。 为了使它看起来像不打开工作簿，您可以打开/closuresScreenUpdating 。

尝试这个：

 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