Copy Paste CSV files to one xlsm workbook

Question

I am trying to pull the data from 500 CSV files all in one folder (the xlsm file is in the same folder). I have the vba checking to see if there are enough available rows in the sheet to fit the next file to be copied/pasted over, and if there aren't then it will create a new sheet and start from range(a1) on the new sheet. The msgbox at the end is just a double check to make sure all the files are copying over.

The issue is that some of the data is not copying over and I can't figure out why. Thoughts?

Public CurrRow, RemRows, TotRows As Long

Sub Open_CSV()

Dim MyFile, FolderPath, myExtension As String
'Dim MyObj As Object, MySource As Object, file As Variant
Dim csv As Variant
Dim wb As Workbook
Dim strDir As String
Dim fso As Object
Dim objFiles As Object
Dim obj As Object
Dim lngFileCount, lastrow As Long

FolderPath = Application.ActiveWorkbook.Path & Application.PathSeparator 'assigning path to get to both workbooks folder
myExtension = "*.csv" 'only look at csv files
MyFile = Dir(CurDir() & "\" & myExtension) 'setting loop variable to ref folder and files

'getting a count of total number of files in folder
strDir = Application.ActiveWorkbook.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFiles = fso.GetFolder(strDir).Files
lngFileCount = objFiles.Count

y = lngFileCount - 2 'folder file count minus tool.CSV_Import2 file

x = 1 'setting loop counter
Z = 1 'setting counter for new sheets
TotRows = 1048576 'total number of rows per sheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False


Do While MyFile <> ""
    Set wb = Workbooks.Open(Filename:=FolderPath & MyFile)
        wb.Activate

        With ActiveSheet
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With

        If x = 1 Then 'need to make the first paste of data in the first row
            Range("A1").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Windows("tool.CSV_Import2.xlsm").Activate
            Range("A1").Select
            ActiveSheet.Paste

        Else
            Range("A1").Select 'making all pastes after the first file to the next empty row
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy

            Windows("tool.CSV_Import2.xlsm").Activate
            Range("A1").Select
            Selection.End(xlDown).Select
            Selection.Offset(1, 0).Select
            CurrRow = ActiveCell.Row 'last row with data number
            RemRows = TotRows - CurrRow 'how many rows are left?

            If lastrow < RemRows Then 'if the import has fewer row than available rows
                ActiveSheet.Paste
            Else
                Sheets.Add.Name = Z
                Sheets(Z).Activate
                    Z = Z + 1
                Range("A1").Select 'direct paste here is applicable since it's the first paste
                ActiveSheet.Paste
            End If
        End If

    wb.Close 'close file

    If x = y Then 'if loop counter is equal to number of csv files in folder exit loop
        Exit Do
    End If

    x = x + 1

Loop

MsgBox x

End Sub

Does your loop ever end? The string `MyFile` doesn't seem to change inside the loop. Is this stepping through each .csv within the folder? — bp_, Nov 03 '14 at 18:25
Check out this SO answer : _[Here](http://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba)_. It will help with your loop. Not sure what your intent is with `Dir(CurDir() & "\" & myExtension)`, but I do not think it is doing what you want. — bp_, Nov 03 '14 at 18:37
This might not make a difference, but try adding `& "\"` to the end of your `strDir` variable. — BobbitWormJoe, Nov 03 '14 at 18:40

barryleajo · Answer 1 · 2014-11-03T22:28:31.750

1

Does your data have 'gaps' in it?

If so your lines Range(Selection, Selection.End(xlDown)).Select will select up to the gaps even though there may be data below.

Try changing these to Range(Selection, Selection.End(xlUp)).Select

In response to your comment:

Yes looks like it too. Well done for identifying the problem. You don't seem to be changing MyFile anywhere within your 'Do While MyFile <> "" ' loop.

Suggest that you consider binning this loop in favour of a 'For Each wb in objFiles' loop and tweaking your code accordingly. Using this method you don't have to count, keep track of or test where you are with the progress of the files.

edited Nov 03 '14 at 22:28

answered Nov 03 '14 at 18:53

barryleajo

1,956
2
12
13

There are no gaps in the data sets. When looking closer at the results of the imports of all 500, it appears that the code is running through the same file 500 times and copy/pasting the same data. – James Nov 03 '14 at 20:53
1

I needed to add MyFile = Dir This enables me to loop through each file. – James Nov 04 '14 at 18:37

score 1 · Accepted Answer · answered Nov 04 '14 at 18:38

1

I needed to add

MyFile = Dir

before the "Loop" at the end of the code.

This enables me to loop through each file.

answered Nov 04 '14 at 18:38

James

429
1
8
17

Then there is no reason to use the FileSystemObject. `DIR` function is actually much faster anyways. – David Zemens Nov 04 '14 at 19:17

Copy Paste CSV files to one xlsm workbook

2 Answers2