Results 1 to 4 of 4
  1. #1
    Join Date
    May 2009
    Posts
    3

    Unanswered: Copy worksheets from multiple workbooks into specific tab in master

    Hello,
    I would like to copy the entire contents (data) of "Sheet1" from multiple workbooks all under a folder to a master workbook named Headcount Rollup Template. Each sheet should be imported to a particular tab in the master.

    I have set up a sheet within my master called "Tab Names" that contains the table I am referencing to map the file to the sheet tab name. It is set up like this:

    Wbk Name Sht Name
    Active HC - US Data.xls US HC
    Active HC - UK Data.xls UK HC
    Active HC - France Data.xls FRA HC

    Example: all data in "Sheet1" in Active HC - US Data.xls should be copied to tab "US HC" in master workbook

    I have been working with the code below but getting an "Object Required" error when it runs.

    Here is my current code that returns an object required error:

    Sub ImportSheets()
    Dim Path As String
    Dim filename As String
    Dim sht As Worksheet
    Dim wkB As Workbook
    Dim i As Integer
    Dim r As Range
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    'Import the first worksheet for each file under R:\HC Data
    Path = "R:\HR Ops Team Folders\Reporting & Analysis\Headcount\HC Data"
    filename = Dir(Path & "\*.xls")
    i = 1
    Do While filename <> ""
    For Each r In Worksheets("Tab Names").Range("A2:A9")
    If r.Value = filename Then
    'this assumes that the sheet name is in the next column
    Set sht = ThisWorkbook.Sheets(r.Offset(0, 1).Value)
    Exit For
    End If
    Next
    Workbooks.Open filename:=Path & "\" & filename
    If SheetExists("Sheet1") Then
    Set wkB = ActiveWorkbook
    Wbk.Sheets("Sheet1").Cells.Copy Destination:=sht.[A1]
    'ActiveSheet.Name = "Sheet" & i
    i = i + 1
    wkB.Close savechanges:=False
    Else
    MsgBox "Sheets1 does not exist in file '" & filename & "'", vbExclamation, "ERROR !!"
    ActiveWorkbook.Close savechanges:=False
    End If
    filename = Dir
    Loop
    Sheets("Tracking #").Select
    MsgBox "All files have been imported successfully!"
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    End Sub

    __________________________________________________ _________
    Function SheetExists(ByVal sName As String)
    Dim sht As Worksheet

    SheetExists = True
    For Each sht In ActiveWorkbook.Sheets
    If sht.Name = sName Then Exit Function
    Next sht

    SheetExists = False
    End Function


    Any help is greatly appreciated!!

  2. #2
    Join Date
    May 2009
    Posts
    3
    Sorry, should have been more clear about the error.

    The code will run until it gets to this line:
    Wbk.Sheets("Sheet1").Cells.Copy Destination:=sht.[A1]

    When I hit the debug button, the error message appears:
    "Run-Time Error "424": Object Required

    Then in the watch window it displays:
    Expression Value Type
    Importsheets <Expression not defined in context> Empty

  3. #3
    Join Date
    Apr 2004
    Location
    Derbyshire, UK
    Posts
    789
    Provided Answers: 1
    Quote Originally Posted by JimLes
    Hello,
    I would like to copy the entire contents (data) of "Sheet1" from multiple workbooks all under a folder to a master workbook named Headcount Rollup Template. Each sheet should be imported to a particular tab in the master.

    I have set up a sheet within my master called "Tab Names" that contains the table I am referencing to map the file to the sheet tab name. It is set up like this:

    Wbk Name Sht Name
    Active HC - US Data.xls US HC
    Active HC - UK Data.xls UK HC
    Active HC - France Data.xls FRA HC

    Example: all data in "Sheet1" in Active HC - US Data.xls should be copied to tab "US HC" in master workbook

    I have been working with the code below but getting an "Object Required" error when it runs.

    Here is my current code that returns an object required error:

    Sub ImportSheets()
    Dim Path As String
    Dim filename As String
    Dim sht As Worksheet
    Dim wkB As Workbook
    Dim i As Integer
    Dim r As Range
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    'Import the first worksheet for each file under R:\HC Data
    Path = "R:\HR Ops Team Folders\Reporting & Analysis\Headcount\HC Data"
    filename = Dir(Path & "\*.xls")
    i = 1
    Do While filename <> ""
    For Each r In Worksheets("Tab Names").Range("A2:A9")
    If r.Value = filename Then
    'this assumes that the sheet name is in the next column
    Set sht = ThisWorkbook.Sheets(r.Offset(0, 1).Value)
    Exit For
    End If
    Next
    Workbooks.Open filename:=Path & "\" & filename
    If SheetExists("Sheet1") Then
    Set wkB = ActiveWorkbook
    Wbk.Sheets("Sheet1").Cells.Copy Destination:=sht.[A1]
    'ActiveSheet.Name = "Sheet" & i
    i = i + 1
    wkB.Close savechanges:=False
    Else
    MsgBox "Sheets1 does not exist in file '" & filename & "'", vbExclamation, "ERROR !!"
    ActiveWorkbook.Close savechanges:=False
    End If
    filename = Dir
    Loop
    Sheets("Tracking #").Select
    MsgBox "All files have been imported successfully!"
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    End Sub

    __________________________________________________ _________
    Function SheetExists(ByVal sName As String)
    Dim sht As Worksheet

    SheetExists = True
    For Each sht In ActiveWorkbook.Sheets
    If sht.Name = sName Then Exit Function
    Next sht

    SheetExists = False
    End Function


    Any help is greatly appreciated!!
    Hi

    Just a shot in the dark but you could try this small mod to your code
    Code:
    Sub ImportSheets()
        Dim Path As String
        Dim filename As String
        Dim sht As Worksheet
        Dim Wkb As Workbook
        Dim i As Integer
        Dim r As Range
        
        Application.Calculation = xlCalculationManual
        Application.DisplayAlerts = False
        'Import the first worksheet for each file under R:\HC Data
        Path = "R:\HR Ops Team Folders\Reporting & Analysis\Headcount\HC Data"
        filename = Dir(Path & "\*.xls")
        i = 1
        Do While filename <> ""
            For Each r In Worksheets("Tab Names").Range("A2:A9")
                If r.Value = filename Then
                    'this assumes that the sheet name is in the next column
                    Set sht = ThisWorkbook.Sheets(r.Offset(0, 1).Value)
                    Workbooks.Open filename:=Path & "\" & filename
                    If SheetExists("Sheet1") Then
                        Set Wkb = ActiveWorkbook
                        Wbk.Sheets("Sheet1").Cells.Copy Destination:=sht.[A1]
                        'ActiveSheet.Name = "Sheet" & i
                        i = i + 1
                        Wkb.Close savechanges:=False
                    Else
                        MsgBox "Sheets1 does not exist in file '" & filename & "'", vbExclamation, "ERROR !!"
                        ActiveWorkbook.Close savechanges:=False
                    End If
                End If
            Next r
            filename = Dir
        Loop
        Sheets("Tracking #").Select
        MsgBox "All files have been imported successfully!"
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
    End Sub
    This eliminates trying to copy data from a file that is not in your list, and hence will not have the Sht object set (or is set to an object that no longer exists) !?

    MTB

  4. #4
    Join Date
    May 2009
    Posts
    3
    Thanks Mike!

    I set the r value and this code seems to work. I am sure it can probably be cleaned up a bit though.

    Sub ImportSheets()
    Dim Path As String
    Dim filename As String
    Dim sht As Worksheet
    Dim wkB As Workbook
    Dim i As Integer
    Dim r As Range
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    'Set the file path
    Path = Worksheets("wsTabNames").Range("Path")
    filename = Dir(Path & "\*.xls")
    i = 1
    Do While filename <> ""
    'set filenames in worksheet "wsTabNames" in A column to tab name in B column
    Set sh1 = Sheets("wsTabNames")
    Set r = sh1.Range(sh1.Range("A2"), sh1.Range("A2").End(xlDown)) 'this selects all files names in Column A in sheet "wsTabnames"
    For Each r In sh1.Range(sh1.Range("A2"), sh1.Range("A2").End(xlDown))
    If r.Value = filename Then
    Set sht = ThisWorkbook.Sheets(r.Offset(0, 1).Value) 'this assigns filename to tab name in sheet "wsTabNames"
    Exit For
    End If
    Next
    'Next import the first worksheet for each file under R:\HC Data
    Set wbK = Workbooks.Open(filename:=Path & "\" & filename)
    If SheetExists("Sheet1") Then
    Set wkB = ActiveWorkbook
    wbK.Sheets("Sheet1").Cells.Copy 'this copies data to assigned r value tab name
    sht.[A1].PasteSpecial xlPasteValues
    ActiveSheet.Name = "Sheet" & i
    i = i + 1
    wkB.Close savechanges:=False
    Else
    MsgBox "Sheets1 does not exist in file '" & filename & "'", vbExclamation, "ERROR !!"
    ActiveWorkbook.Close savechanges:=False
    End If
    filename = Dir
    Loop

    Sheets("Forecast Data").Select
    MsgBox "All files have been imported successfully!"
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •