Combine all data from multiple excel files into one sheet in new workbook

[gracecyl]

Hi would appreciate some help for VBA code (using Macbook Air) please

1. My data is only in one column (A) and I'd like to copy from cell A2 onwards in every excel file that I have (6 total)
2. Copy to a new workbook
3. Close all the excel files after data has been copied except new workbook

Thank you so much.

I've tried this code I found on Google but it keeps stating "Overflow"

Sub CombineMultipleSheetsToExisting()
   On Error GoTo eh
'declare variables to hold the objects required
   Dim wbDestination As Workbook
   Dim wbSource As Workbook
   Dim wsDestination As Worksheet
   Dim wb As Workbook
   Dim sh As Worksheet
   Dim strSheetName As String
   Dim strDestName As String
   Dim iRws As Integer
   Dim iCols As Integer
   Dim totRws As Integer
   Dim rngEnd As String
   Dim rngSource As Range
'set the active workbook object for the destination book
   Set wbDestination = ActiveWorkbook
'get the name of the active file
   strDestName = wbDestination.Name
'turn off the screen updating to speed things up
   Application.ScreenUpdating = False
'first create new destination worksheet in your Active workbook
   Application.DisplayAlerts = False
'resume next error in case sheet doesn't exist
   On Error Resume Next
   ActiveWorkbook.Sheets("Consolidation").Delete
'reset error trap to go to the error trap at the end
   On Error GoTo eh
   Application.DisplayAlerts = True
'add a new sheet to the workbook
   With ActiveWorkbook
      Set wsDestination = .Sheets.Add(After:=.Sheets(.Sheets.Count))
      wsDestination.Name = "Consolidation"
   End With
'now loop through each of the workbooks open to get the data
   For Each wb In Application.Workbooks
      If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
         Set wbSource = wb
            For Each sh In wbSource.Worksheets
'get the number of rows in the sheet
               sh.Activate
               ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Activate
               iRws = ActiveCell.Row
               iCols = ActiveCell.Column
               rngEnd = sh.Cells(iRws, iCols).Address
               Set rngSource = sh.Range("A1:" & rngEnd)
'find the last row in the destination sheet
               wbDestination.Activate
               Set wsDestination = ActiveSheet
               wsDestination.Cells.SpecialCells(xlCellTypeLastCell).Select
               totRws = ActiveCell.Row
'check if there are enough rows to paste the data
               If totRws + rngSource.Rows.Count > wsDestination.Rows.Count Then
                  MsgBox "There are not enough rows to place the data in the Consolidation worksheet."
                  GoTo eh
               End If
'add a row to paste on the next row down if you are not in row 1
               If totRws <> 1 Then totRws = totRws + 1
               rngSource.Copy Destination:=wsDestination.Range("A" & totRws)
           Next sh
         End If
   Next wb
'now close all the open files except the one you want
   For Each wb In Application.Workbooks
      If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
         wb.Close False
      End If
   Next wb
 
'clean up the objects to release the memory
   Set wbDestination = Nothing
   Set wbSource = Nothing
   Set wsDestination = Nothing
   Set rngSource = Nothing
   Set wb = Nothing
'turn on the screen updating when complete
   Application.ScreenUpdating = False
Exit Sub
eh:
MsgBox Err.Description
End Sub

 

[mumps]

Do you want to combine the data from the first sheet in each of the 6 files or from multiple sheets in each of the 6 files? Are the six files already open?

 

[gracecyl]

Yes, in the first sheet (there is only one sheet of data in every of the 6 file, and only in the first column).
All 6 files are opened and also saved in the same folder

 

[gracecyl]

Do you want to combine the data from the first sheet in each of the 6 files or from multiple sheets in each of the 6 files? Are the six files already open?

Yes, in the first sheet (there is only one sheet of data in every of the 6 file, and only in the first column).
All 6 files are opened and also saved in the same folder

 

[mumps]

Open a new, blank workbook. Copy/paste the macro below into a regular module and run it from there. Make sure that only the new workbook and the other six workbooks are the only workbooks open before running the macro.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim WB As Workbook, desWB As Workbook, desWS As Worksheet
    Set desWB = ThisWorkbook
    Set desWS = desWB.Sheets("Sheet1")
    For Each WB In Workbooks
        If WB.Name <> desWB.Name Then
            WB.Sheets(1).Range("A2", WB.Sheets(1).Range("A" & Rows.Count).End(xlUp)).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
        End If
        WB.Close False
    Next WB
    Application.ScreenUpdating = True
End Sub