Results 1 to 4 of 4
  1. #1
    Join Date
    Sep 2002
    Location
    NJ
    Posts
    139

    Unanswered: how to open sheet1 from multiple workbook into one workbook

    Hi,

    I am trying to open sheet1 of multiple workbooks into one workbook, naming each sheet1: sheet 2, 3,4 and 5. All the workbooks are located in the same directory c:\temp\ but have different names and the names always vary.

    How do I loop through and open all the sheet1 one from each workbook in that directory and open them into one workbook?

    alexxx

  2. #2
    Join Date
    Jan 2004
    Location
    The Netherlands
    Posts
    421

    Try this for starters

    Code:
    Sub GetAllSheet1s()
        Dim YourPath As String, myFile As String, myName As String
        YourPath = "C:\"
        myFile = Dir("*.XLS")
        ' First add a new workbook
        Workbooks.Add
        myName = ActiveWorkbook.Name
        Do While myFile <> ""
            Workbooks.Open Filename:=YourPath & myFile
            Sheets("Sheet1").Select
            Sheets("Sheet1").Copy Before:=Workbooks(myName).Sheets(1)
            Windows(myFile).Activate
            ActiveWindow.Close
            myFile = Dir
        Loop
            
    End Sub
    Greetz

  3. #3
    Join Date
    Sep 2002
    Location
    NJ
    Posts
    139
    Hi,

    I have modified the code to get what i want but that only works partially.

    Dim YourPath As String, myFile As String, myName As String
    Dim i As Integer
    YourPath = "C:\LOGCALL\"
    myFile = Dir("C:\LOGCALL\*.XLS")
    myName = ActiveWorkbook.Name
    Do While myFile <> ""

    Workbooks.Open filename:=YourPath & myFile
    Sheets("Sheet1").Select
    Sheets("Sheet1").Copy after:=Workbooks(myName).Sheets(3)
    Windows(myFile).Activate
    ActiveWindow.Close
    For i = 2 To 5 ' or to the number of newly added *.xls sheet in the directory
    Sheets("Sheet1 (" & i & ")").Select
    If Sheets("Sheet1") = True Or Sheets("Sheet2") = True Or Sheets("Sheet3") = True Then
    Exit For
    Else
    Sheets("Sheet1 (" & i & ")").Name = "Sheet" & i
    End If
    Next i
    myFile = Dir
    Loop

    Sheets("Sheet1").Select


    however it is not working well. Here is what I want the code to do:
    I have a workbook open already with some functionality. the first three sheets are populated with data. When I run the code, it has to open the various sheets1 from other workbooks and add them to my current workbook, but I don't want to see the opening, copying and the closing of those workbooks and I want to newlly added sheets to be sequential starting at sheet4 and on and in order. I don't want sheet1 (1) format. Can this be done?
    Your help is greatly appreciated.

  4. #4
    Join Date
    Apr 2004
    Location
    Derbyshire, UK
    Posts
    789
    Provided Answers: 1

    Copying Sheets into Workbook

    Hi

    Try this procedure (with function).

    This procedure copies 'sheet1' from all sheets workbook in the LOGCALL directory, after the sheet that is active when the porcedure starts.

    It checks that the sheet name to be used does not exist, and if it does trys the next number (upto 20), if sheet1 exists in the opened file.

    Hope this hepls

    Code:
    Sub ImportSheets()
        Dim Path As String
        Dim filename As String
        Dim sht As Worksheet
        Dim wkB As Workbook
        Dim i As Integer
        
        Path = "C:\LOGCALL"
        filename = Dir(Path & "\*.xls")
    Application.ScreenUpdating = False
        i = 1
        Do While filename <> ""
            'CHECK SHEET NAME TO BE CREATED DOES NOT EXIST
            Do While SheetExists("Sheet" & i)
                i = i + 1
                If i = 20 Then
                    MsgBox "Too many sheets !", vbExclamation, "ERROR !!"
                    Application.ScreenUpdating = True
                    Exit Sub
                End If
            Loop
            
            Set sht = ActiveSheet
            Workbooks.Open filename:=Path & "\" & filename
            If SheetExists("Sheet1") Then
                Set wkB = ActiveWorkbook
                Sheets("Sheet1").Copy After:=sht
                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
    Application.ScreenUpdating = True
    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
    MTB

Posting Permissions

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