Error Checking in Excel
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 6 of 6

Thread: Multiple Files

  1. #1
    New Member
    Join Date
    Apr 2002
    Posts
    1
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    I use EXCEL 97. I have approxiamately 50 files on my desk top. I would like to transfer sheet 1 on all 50 files to a new workbook, 50 sheets deep. Is this possible with out openeing each file individually and Move/Copy Sheet to new book individually?

    Thanks in advance for any help you can provide.

  2. #2
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Christchurch New Zealand
    Posts
    1,030
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    you would probably have to write some code to do this probably the easist would be to open the workbook then record a macro doing the proceedure you want then just run the macro on each workbook

    or you could get excel to open up each workbook but that would take just as long to write the code depending on the workbook names..

  3. #3
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi
    I would place all of the xls files which contain the sheets to be transfered in a new folder. Create a new workbook in this same folder. Paste this code into a standard module, in the new workbook, and run it.
    If any of the workbooks in this folder do not have a "Sheet1" then an error will be generated.

    Sub CallingAllSheets()
    Dim FS, i
    Dim PlaceRow As Long
    Dim OpenedName As String
    Dim DoNotReopenActiveWB_Name As String
    Dim RecievingWb As String

    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    DoNotReopenActiveWB_Name = ActiveWorkbook.Path & "" & ActiveWorkbook.Name
    RecievingWb = ActiveWorkbook.Name
    PlaceRow = 1
    Set FS = Application.FileSearch
    With FS
    .LookIn = ActiveWorkbook.Path
    .Filename = "*.xls"
    If .Execute Then
    For i = 1 To .FoundFiles.Count
    If .FoundFiles(i) <> DoNotReopenActiveWB_Name Then
    Workbooks.Open .FoundFiles(i)
    OpenedName = ActiveWorkbook.Name
    Workbooks(OpenedName).Sheets("Sheet1"). _
    Copy Before:=Workbooks(RecievingWb).Sheets(1)
    Workbooks(OpenedName).Close savechanges:=False
    End If
    Next i
    End If
    End With
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End Sub


    Tom

  4. #4
    Board Regular
    Join Date
    Mar 2002
    Location
    Wellington
    Posts
    115
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi,

    You may want to try the following:

    Sub CopySheets()
    Const DeskTopDir = "c:winntprofilesall usersdesktop"
    Dim iFileName As String
    Dim iWorkBook As String
    iWorkBook = ThisWorkbook.Name
    iFileName = Dir(DeskTopDir)
    Do While iFileName <> ""
    If LCase(Right(iFileName, 4)) = ".xls" Then
    Workbooks.Open (DeskTopDir & iFileName)
    Sheets("sheet1").Name = Left(iFileName, Len(iFileName) - 4)
    Sheets(Left(iFileName, Len(iFileName) - 4)).Copy _
    After:=Workbooks(iWorkBook).Sheets(Workbooks(iWorkBook).Sheets.Count)
    Workbooks(iFileName).Close (False)
    End If
    iFileName = Dir
    Loop
    End Sub

    For the desktop directory, you might have to change it to whatever desktop directory on yours, eg. windows 98 would be something like : c:windowsdesktop, etc.

    And if the name of the sheet you wanted to copy is not called "sheet1", then you also have to change that. Alternatively, if you want to copy the first of the workbook, instead of using 'sheets("sheet1")', change it to 'sheets(1)'.

    HTH

  5. #5
    Board Regular swaink's Avatar
    Join Date
    Feb 2002
    Location
    51.421818,-0.977139
    Posts
    432
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    HI Tom

    I've read this with interest because I have a similar requirement, however when I step through the code if the original workbook is found it still try's to open it.

    Any Ideas

    Kev

  6. #6
    Board Regular
    Join Date
    Apr 2002
    Posts
    135
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    I have a similar problem.The only difference is the files are on the internet.

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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