CODEWITHSUNDEEP
vbaexcel
mou
mou

Reputation: 51

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

I'm new to VBA and trying to automate updates to a workbook. I have a source Workbook A and 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.

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

Upvotes: 4

Views: 94505

Answers (2)

dheeraj raj
dheeraj raj

Reputation: 21

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

Upvotes: 1

L42
L42

Reputation: 19727

sht1 and sht2 should 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 ScreenUpdating on/off.

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

Upvotes: 15

Related Questions