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

Copy sheet from one WB to another using VBA without opening destination WB

提问by mou

I'm new to VBA and trying to automate updates to a workbook. I have a source Workbook Aand a destination Workbook B. Both have a sheet called roll out summary. I want the user to update this sheet in A and click update button which should run my macro. This macro should automatically update the sheet in workbook B without opening Workbook B.

我是 VBA 新手，正在尝试自动更新工作簿。我有一个源工作簿 A和一个目标工作簿 B。两者都有一个名为roll out summary 的表。我希望用户在 A 中更新此工作表，然后单击应运行我的宏的更新按钮。此宏应在不打开工作簿 B 的情况下自动更新工作簿 B 中的工作表。

I'm trying this code but it doesn't work and gives me an error:

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

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

回答by L42

sht1and sht2should be declare as Worksheet. As for updating the workbook without opening it, it can be done but a different approach will be needed. To make it look like you're not opening the workbook, you can turn ScreenUpdatingon/off.

sht1并sht2应声明为Worksheet. 至于在不打开工作簿的情况下更新工作簿，它可以完成，但需要不同的方法。为了使它看起来好像您没有打开工作簿，您可以打开ScreenUpdating/关闭。

Try this:

尝试这个：

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

回答by dheeraj raj

Use this - This worked for me

使用这个 - 这对我有用

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