Combining 7 Excel Files into 1

[zalik22]

Hi,

I have 7 Excel files in a folder called "Test" on my desktop and need to merge them into a single spreadsheet called "Combined Data". The data in each file has one spreadsheet, all the columns are the same, and the data starts on row 8. For all the files, I want the data to extract from Row 8, and copy until the end. The "Combined Data" file would have one spreadsheet from file1 row8-end, followed by file2 row8-end, etc.

Thanks in advance!

 

[Fluff]

Are you trying to combine the files into an existing workbook?

 

[zalik22]

Are you trying to combine the files into an existing workbook?

Either is fine.

 

[zalik22]

Either is fine.

A new file named "Combined Data" is preferred.

 

[Fluff]

Ok how about

Sub Zalik()
   Dim Pth As String, Fname As String
   Dim Ws As Worksheet
   
   Application.ScreenUpdating = False
   Set Ws = Sheets("Combined Data")
   Pth = Environ("Userprofile") & "\Desktop\Test\"
   Fname = Dir(Pth & "*.xls*")
   Do Until Fname = ""
      With Workbooks.Open(Pth & Fname)
         With .Sheets(1)
            .Range("A8", .Range("A" & Rows.Count).End(xlUp)).EntireRow.Copy Ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
         End With
         .Close False
      End With
      Fname = Dir
   Loop
End Sub

This will copy the data to a sheet called "Combined Data" in the active workbook.

 

[RoryA]

If you have Power Query, you can use it to combine all files in a folder.

 

[zalik22]

Ok how about

Sub Zalik()
   Dim Pth As String, Fname As String
   Dim Ws As Worksheet
  
   Application.ScreenUpdating = False
   Set Ws = Sheets("Combined Data")
   Pth = Environ("Userprofile") & "\Desktop\Test\"
   Fname = Dir(Pth & "*.xls*")
   Do Until Fname = ""
      With Workbooks.Open(Pth & Fname)
         With .Sheets(1)
            .Range("A8", .Range("A" & Rows.Count).End(xlUp)).EntireRow.Copy Ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
         End With
         .Close False
      End With
      Fname = Dir
   Loop
End Sub

This will copy the data to a sheet called "Combined Data" in the active workbook.

This didn't work, this only copied rows 1-8, it didn't get anything below it.

 

[Fluff]

Is there any particular column that will always have data on the last used row?

 

[Richard U]

Is there any particular column that will always have data on the last used row?

Ron DeBruin's site has a function that will always return the last row.

Function GetLast(choice As Long, rng As Range)
'Ron de Bruin, 5 May 2008
' 1 = GetLast row
' 2 = GetLast column
' 3 = GetLast cell
    Dim lrw As Long
    Dim Lcol As Long

    Select Case choice

    Case 1:
        On Error Resume Next
        GetLast = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        On Error GoTo 0

    Case 2:
        On Error Resume Next
        GetLast = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

    Case 3:
        On Error Resume Next
        lrw = rng.Find(What:="*", _
                       After:=rng.Cells(1), _
                       lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
        On Error GoTo 0

        On Error Resume Next
        Lcol = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

        On Error Resume Next
        GetLast = rng.Parent.Cells(lrw, Lcol).Address(False, False)
        If Err.Number > 0 Then
            GetLast = rng.Cells(1).Address(False, False)
            Err.Clear
        End If
        On Error GoTo 0
    If GetLast = 0 Then GetLast = 1
    End Select
End Function

 

[zalik22]

Is there any particular column that will always have data on the last used row?

Columns A-X, row 8 to end of spreadsheet is what I want to copy. The code copied rows 1-8 7 times.