copypaste from workbook to another

[enzzz88]

Hi guys,

i am a newbie to vba and i am trying to copy several worksheets from a closed file into my current open one.

the code is the following


Sub Import()


'copy data from closed workbook to active workbook


Dim xlApp As Application
Dim xlBook As Workbook
Dim wb1 As Workbook
Dim Sh As Object
Dim report As String


Set xlApp = CreateObject("Excel.Application")
'Path source workbook

Application.FileDialog(msoFileDialogFilePicker).Show
report = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)


Set xlBook = xlApp.Workbooks.Open(report)

xlBook.Worksheets("WC_holiday_provision").UsedRange.Copy
xlApp.DisplayAlerts = False
Set wb1 = Workbooks("CZ_Payroll_Macro.xlsb")
Set Sh = wb1.Worksheets("WC_holiday_provision")
Sh.Activate
wb1.Worksheets("WC_holiday_provision").Range("A1").Select
Sh.Paste


Now, i would like to get rid of the SH.ACTIVATE and SH.PASTE and paste directly withouth having to activate every sheet window, any ideas?

thanks a lot

 

[JackDanIce]

Welcome to the board. Try:

Sub Import()

    'copy data from closed workbook to active workbook
    Dim xlBook  As Workbook
    Dim report  As String
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        'Path source workbook
        .FileDialog(msoFileDialogFilePicker).Show
        report = .FileDialog(msoFileDialogFilePicker).SelectedItems(1)
    End With
    
    Set xlBook = xlApp.Workbooks.Open(report)
    
    With Workbooks("CZ_Payroll_Macro.xlsb").Worksheets("WC_holiday_provision")
        .Cells.ClearContents
        xlBook.Worksheets("WC_holiday_provision").UsedRange.Copy .Cells(1, 1)
    End With
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    
    Set xlBook = Nothing
    
End Sub

 

[enzzz88]

Welcome to the board. Try:

Sub Import()

    'copy data from closed workbook to active workbook
    Dim xlBook  As Workbook
    Dim report  As String
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        'Path source workbook
        .FileDialog(msoFileDialogFilePicker).Show
        report = .FileDialog(msoFileDialogFilePicker).SelectedItems(1)
    End With
    
    Set xlBook = xlApp.Workbooks.Open(report)
    
    With Workbooks("CZ_Payroll_Macro.xlsb").Worksheets("WC_holiday_provision")
        .Cells.ClearContents
        xlBook.Worksheets("WC_holiday_provision").UsedRange.Copy .Cells(1, 1)
    End With
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    
    Set xlBook = Nothing
    
End Sub

thanks for the reply, however what i am trying to do is to copy from the file i open, which has a sheet called "WC_Holiday_provision" and copy paste it to the file called CZ_payroll_macro, within it's sheet called wc holiday provision too.
Additionally, i have to do this for other n sheets.

I hope this clarifies.

 

[JackDanIce]

What happened when you ran the macro?

What is the name of the workbook open?
Is the macro being run from this open workbook?

What are other n sheets (names?) where do they copy from and to?

Try to consider you're looking at your PC screen describing the worksheet to anyone reading who cannot see the screen. Are you explaining precisely and clearly enough to understand your requirement?

 

[enzzz88]

I'll try to explain better:

I have an active file, called "CZ_payroll" from which i want to run the macro, the macro will open another file called "Input_File", into the "Input_File" there are n worksheets (ws1, ws2, ws3 etc), for each ws i want to copy the content and paste it into the corresponding ws of my original open file - e.g ws1 content of the "Input_File" will be transferred to the ws1 of "CZ_payroll" and so on.

The original code i posted it's working, however, if you look at the end of the instructions i have to enter the command .activate and .select in order to paste the content of my input file, which is not ideal due to the high number of worksheets that need to be copied - eventually the code would become inefficient and slow.


i hope it's clear now

 

[JackDanIce]

Replace all of your code in CZ_payroll and try running:

Sub Import()

    Dim w           As Long
    Dim L(1 To 2)   As Long
    Dim wkb As Workbook
    
    Application.ScreenUpdating = False
    
    Set wkb = Workbooks.Open(SelectFile, ReadOnly:=True)
    ThisWorkbook.Activate
    
    For w = 1 To wkb.Worksheets.Count
        With wkb.sheets(w)
            If Evaluate(.Name & "!A1") Then
                L(1) = LastRow(wkb.sheets(w)): L(2) = LastCol(wkb.sheets(w))
                ThisWorkbook.sheets(.Name).Cells(1, 1).Resize(LR, LC).Value = wkb.sheets(w).Cells(1, 1).Resize(LR, LC).Value
            End If
        End With
    Next w
    
    wkb.Close
    sheets(wkb.sheets(1).Name).Select

    Application.ScreenUpdating = True
    
    Erase L
    Set wkb = Nothing
    
End Sub

Private Function SelectFile() As Workbook

    With Application
        .fildialog(msoFileDialogFilePicker).Show
        SelectFile = .FileDialog(msoFileDialogFilePicker).SelectedItems(1)
    End With

End Function

Private Function LastRow(ByRef wks As Worksheet) As Long

    With wks
        LastRow = .Cells.Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByRows).Row
    End With
    
End Function

Private Function LastCol(ByRef wks As Worksheet) As Long

    With wks
        LastCol = .Cells.Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByColumns).Column
    End With
    
End Function

 

[enzzz88]

Replace all of your code in CZ_payroll and try running:

Sub Import()

    Dim w           As Long
    Dim L(1 To 2)   As Long
    Dim wkb As Workbook
    
    Application.ScreenUpdating = False
    
    Set wkb = Workbooks.Open(SelectFile, ReadOnly:=True)
    ThisWorkbook.Activate
    
    For w = 1 To wkb.Worksheets.Count
        With wkb.sheets(w)
            If Evaluate(.Name & "!A1") Then
                L(1) = LastRow(wkb.sheets(w)): L(2) = LastCol(wkb.sheets(w))
                ThisWorkbook.sheets(.Name).Cells(1, 1).Resize(LR, LC).Value = wkb.sheets(w).Cells(1, 1).Resize(LR, LC).Value
            End If
        End With
    Next w
    
    wkb.Close
    sheets(wkb.sheets(1).Name).Select

    Application.ScreenUpdating = True
    
    Erase L
    Set wkb = Nothing
    
End Sub

Private Function SelectFile() As Workbook

    With Application
        .fildialog(msoFileDialogFilePicker).Show
        SelectFile = .FileDialog(msoFileDialogFilePicker).SelectedItems(1)
    End With

End Function

Private Function LastRow(ByRef wks As Worksheet) As Long

    With wks
        LastRow = .Cells.Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByRows).Row
    End With
    
End Function

Private Function LastCol(ByRef wks As Worksheet) As Long

    With wks
        LastCol = .Cells.Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByColumns).Column
    End With
    
End Function

at the line in bold, SelectFile = .FileDialog(msoFileDialogFilePicker).SelectedItems(1)
i get a runtime error 91:
object variable or with block variable not set

 

[JackDanIce]

Typo, change the Private Function part to:

Private Function SelectFile() As Workbook

    With Application
        .FileDialog(msoFileDialogFilePicker).Show
        SelectFile = .FileDialog(msoFileDialogFilePicker).SelectedItems(1)
    End With

End Function

 

[enzzz88]

Unfortunately, same result

 

[JackDanIce]

My bad, was returning wrong data type from the function, try:

Private Function SelectFile() As String
    
    With Application
        .FileDialog(msoFileDialogFilePicker).Show
        SelectFile = .FileDialog(msoFileDialogFilePicker).SelectedItems(1)
    End With
    
End Function