Macro to append data from different files into same single sheet in open workbook

ryan8200

Active Member
Joined
Aug 21, 2011
Messages
357
I have 4 files located in the same path with filenames: Season.csv, Season(1).csv, Season(2).csv, Season(3).csv.

I would like the macro to copy first row from first file (Season.csv) but append from 2 rows for the other files

I have tried the following code. The code run successfully with no error but no data has been copied. What have go wrong ? Any Excel expert can give me a helping hand ?

VBA Code:
Public Sub MergeFiles()

    Dim path As String
    Dim shtDest As Worksheet
    Dim Wkb As Workbook
    Dim CopyRng As Range, Dest As Range
    Dim RowofCopySheet As Integer
    Dim selectedFiles As Variant, filename As Variant
   
    RowofCopySheet = 2 ' Row to start on in the sheets you are copying from
   
    path = ("C:\Users\danny8\Desktop\Consolidate")
   
    selectedFiles = SelectFiles(path)

    If IsArray(selectedFiles) Then
   
        Application.EnableEvents = False
        Application.ScreenUpdating = False
       
        Set shtDest = ActiveWorkbook.Sheets("Sheet1")
   
        'Open and merge each selected file
       
        For Each filename In selectedFiles
            If filename <> ActiveWorkbook.FullName Then
                Set Wkb = Workbooks.Open(filename)
                'Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
                With Wkb.Sheets(1)
                    Set CopyRng = .Range(.Cells(RowofCopySheet, 1), _
                        .Cells(Cells(Rows.Count, 1).End(xlUp).Row, .Cells(1, Columns.Count).End(xlToLeft).Column))
                End With
                Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
                CopyRng.Copy
                Dest.PasteSpecial xlPasteValuesAndNumberFormats
                Application.CutCopyMode = False 'Clear Clipboard
                Wkb.Close False
            End If
        Next
   
        Application.EnableEvents = True
        Application.ScreenUpdating = True
   
    Else
   
        MsgBox "No files were selected"
   
    End If
   
    Range("A1").Select
   
    MsgBox "Done!"
   
End Sub

Private Function SelectFiles(startFolderPath As String) As Variant

    Dim Filter As String
    Dim FilterIndex As Integer
   
    'File filters
    Filter = "Excel workbooks (*.csv), *.csv"
    FilterIndex = 1
   
    'Set start drive and path
    ChDrive (startFolderPath)
    ChDir (startFolderPath)
   
    With Application
        'Get array of selected file(s)
        SelectFiles = .GetOpenFilename(Filter, FilterIndex, "Select File(s) to Merge", , MultiSelect:=True)
       
        'Reset start drive and path
        ChDrive (.DefaultFilePath)
        ChDir (.DefaultFilePath)
    End With

End Function
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

Forum statistics

Threads
1,223,231
Messages
6,170,885
Members
452,364
Latest member
springate

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top