Need to import sheets from one Excel file to another using VBA

I couldn't find the buttons, but I put a pair on the sheet myself. Anyway, now there's a really bizarre issue. (BTW, the copy worked perfectly!) On one of the sheets copied into the new workbook, the cell colors are completely messed up. In the source sheet, I have some nice pastel grey and beige cell backgrounds, but after the copy, the cell colors are some horrible bright neon colors. Neon red where the grey was and neon green where the beige was. That the heck? And how can I make sure the source cell colors match when the sheet gets pasted in? Now I'm stumped.

Any thoughts on how to adjust this? (It did the same thing when I tried to copy by hand in my original testing. Again, no clue as to why.)

No problem - had enough rain around here to float large cruise ships ourselves, so I understand.

Let me know how it works out for you.  I actually tested this and it all worked for me here.

I don't figure you'll use the select files button too often, but thought it would make it easier (and more error free) for you to have it than to have to figure out a way to correctly enter the full paths to some unspecified number of files.

Sorry for the delay. I was not in the office yesterday due to the danger of flooding at my residence. I am looking at this now and will get back to you soon. THANK YOU for providing this?

Dennis

I've prepared a workbook for you - based on what you've asked for it should work except the last step of saving the destination workbook is left up to the user.  I've added a button on the one sheet in it that will, I hope, help you build up the list of files to be processed.  They're saved in column A of the one sheet and you can either add to it or rebuild it completely at any time.

Here is a link to the file which is located at MediaFire.com in my account's files:

http://www.mediafire.com/download.php?yy3tddfg5l30ytj

Here is the code from the workbook, it should work in pretty much any version of Excel.  I realize you're using Excel 2010, but others may want to use it in a pre-2007 version of Excel.

Sub CopyAllSheetsFromAllBooks()

  Dim destWB As Workbook ' will represent this workbook

  Dim listWS As Worksheet ' will represent Sheet1 (ListSheet) in this workbook

  Dim filesList As Range ' will represent all cells with path\filenames in then

  Dim anyFile As Range ' will represent a single cell with a path\filename in it

  Dim anyLastRow As Long

  Dim maxRows As Long

  Dim sourceWB As Workbook ' will represent each other workbook in turn

  Dim anyWS As Worksheet ' will represent one sheet in the other workbook

  'Assumed 1 sheet in THIS workbook and that it has

  'full path and filenames that are to be processed

  'listed in column A beginning at row 2

  'set references to things in this workbook

  Set destWB = ThisWorkbook

  Set listWS = Sheet1 ' in this workbook

  'here's how to find the last used row in a given column

  'there are times when Rows.Count can cause problems:

  'when running an .xls file in Compatibility mode in Excel 2007/2010

  On Error Resume Next

  Set anyFile = listWS.Range("A" & Rows.Count)

  If Err <> 0 Then

    Err.Clear

    maxRows = 65536 ' assume .xls file

  Else

    maxRows = Rows.Count

  End If

  On Error GoTo 0 ' clear error trapping

  anyLastRow = listWS.Range("A" & maxRows).End(xlUp).Row

  'for an entire sheet you could try listWS.UsedRange.Rows.Count

  'but it can be inaccurate.

  '

  'set up a reference from A2 down to last row with an entry in it

  Set filesList = listWS.Range("A2:A" & anyLastRow)

  'begin working through the list of files

  'this will make things go MUCH faster!

  ' is made TRUE automatically when the Sub ends.

  Application.ScreenUpdating = False

  For Each anyFile In filesList

    'test to make sure it's not an empty cell

    If Not IsEmpty(anyFile) Then

      'make sure the reference is to a valid file

      'for a cell reference, the default property is its .Value

      If Dir$(anyFile) <> "" Then

        'open the file, inhibiting any user prompts

        Application.DisplayAlerts = False

        Set sourceWB = Workbooks.Open(anyFile, False) ' if has links, don't update them

        'work through each worksheet in  the newly opened file

        For Each anyWS In sourceWB.Worksheets

          'copy the sheet to the right end in this workbook

          anyWS.Copy after:=destWB.Worksheets(destWB.Worksheets.Count)

        Next ' end anyWS loop

        'we are done with the other workbook. Close it.

        sourceWB.Close False ' close without saving changes

      End If ' end of test for existing file

    End If ' end of test for empty cell

  Next ' end of anyFile loop

  'the job is done except for cleanup

  'release all used resources back to the system

  'to prevent potential "memory leaks"

  Set sourceWB = Nothing

  Set anyFile = Nothing

  Set filesList = Nothing

  Set listWS = Nothing

  Set destWB = Nothing

  'let the user know they can save this workbook now

  MsgBox "All files have been processed and their sheets have been copied into this workbook.", _

   vbOKOnly + vbInformation, "Task Completed"

End Sub

Sub SelectFiles()

  Dim eraseList As Integer

  Dim listWS As Worksheet

  Dim anyLastRow As Long

  Dim fileChosen As String

  Dim maxRows As Long

  Dim testCell As Range

  eraseList = MsgBox("Do you want to start with a clean list (YES)" & _

   vbCrLf & "or add to the existing list (NO)," & _

   vbCrLf & "or don't do anything (CANCEL)?", _

   vbYesNoCancel + vbQuestion, "Start New List?")

  If eraseList = vbCancel Then

    Exit Sub

  End If

  Set listWS = Sheet1

  'there are times when Rows.Count can cause problems:

  'when running an .xls file in Compatibility mode in Excel 2007/2010

  On Error Resume Next

  Set testCell = listWS.Range("A" & Rows.Count)

  If Err <> 0 Then

    Err.Clear

    maxRows = 65536 ' assume .xls file

  Else

    maxRows = Rows.Count

  End If

  On Error GoTo 0 ' clear error trapping

  Set testCell = Nothing ' no longer needed

  If eraseList = vbYes Then

    anyLastRow = listWS.Range("A" & maxRows).End(xlUp).Row + 1

    listWS.Range("A2:A" & anyLastRow).ClearContents

  End If

  'this will loop continuously until the user either

  'clicks the red-x to close the dialog or clicks the [Cancel] button

  Do Until fileChosen = "False"

    fileChosen = Application.GetOpenFilename("Excel Files *.xls*, *.xls*", , "Select a File To Process")

    If fileChosen <> "False" Then

      listWS.Range("A" & maxRows).End(xlUp).Offset(1, 0) = fileChosen

    End If

  Loop

  'all done, do your final cleanup

  Set listWS = Nothing

End Sub