clunky vba copy sheet1 from book1 to sheet2 book2 - there must be a better way

[Andyatwork]

Hi all,

I have some working code that accomplishes the task but I am sure there is a more elegant solution that someone might be able to suggest.
The goal is to enable a button linked to the macro so the user can click it, pick a file (an xls report of unknown name with one sheet only), and have the contents of the picked file copied to the second sheet which will then be renamed.
This is a precursor to pivoting that data and squirting the pivot results out to a new workbook.

Is there a way of doing the sheet copy without opening the target workbook?

I've been experimenting with filedialog and application.getopenfilename but keep getting compile errors.

My code:

Option Explicit
'wbExt is the source file, wbRpt is the pivot report macrobook
    Dim wbExt As Workbook
    Dim wbRpt As Workbook
 
Sub Copy_Extract()
    
    Dim ExtFile As String
    ExtFile = Application.GetOpenFilename
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    Set wbRpt = ThisWorkbook
    Set wbExt = Application.Workbooks.Open(ExtFile, _
        UpdateLinks:=False, _
        ReadOnly:=True, _
        addtomru:=False)
    wbExt.Sheets(1).Copy After:=wbRpt.Sheets(1)
    wbRpt.Sheets(2).Name = "Extracts"
    wbExt.Close False
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    
End Sub

 

[dmt32]

Hi,
see if change to your code helps:

Sub Copy_Extract()
'wbExt is the source file, wbRpt is the pivot report macrobook
    Dim wbExt As Workbook, wbRpt As Workbook
    Dim ExtFile As Variant
    Dim sTitle As String, sFilter As String


    sTitle = "Select Report File"


    sFilter = "WorkBooks 2003 (*.xls),*.xls," & _
              "WorkBooks 2007 > (*.xlsx),*.xlsx," & _
              "All Excel Files (*.xl*),*.xl*," & _
              "All Files (*.*),*.*"


    ExtFile = Application.GetOpenFilename(sFilter, 1, sTitle)
    If ExtFile = False Then Exit Sub


        With Application
            .ScreenUpdating = False
            .EnableEvents = False
            .DisplayAlerts = False
        End With


        Set wbRpt = ThisWorkbook
        Set wbExt = Application.Workbooks.Open(ExtFile, _
                                               UpdateLinks:=False, _
                                               ReadOnly:=True, _
                                               addtomru:=False)
        wbExt.Sheets(1).Copy After:=wbRpt.Sheets(1)
        wbRpt.Sheets(2).Name = "Extracts"
        wbExt.Close False


        With Application
            .ScreenUpdating = True
            .EnableEvents = True
            .DisplayAlerts = True
        End With


    End Sub

Dave

 

[Andyatwork]

Hi Dave,

Nice, I knew I didn't have any error handling around the file selection and I hadn't tried setting arguments for the GetOpenFilename as I always seem to tie myself in knots working out the syntax. Thank you for the suggestions.

I've added the tweaks and I think it is still functionally doing the same thing but it seems to be doing it without any trouble and I learned stuff! So on the principle of "if it ain't broke, don't fix it" I am going to go with that and start looking at automating a pivot and breaking the results out into separate tabs in a new workbook based on Page Filter. I'll probably be asking for help on that shortly.

Many thanks

Andy