VBA, Excel 2007, How to open multiple files in a folder & loop main code

[weenie]

Hello,

I have main code called 'ScribeMainTEMPE'. In main code it executes 'Call ImportData' which is pasted below. It opens 1 .csv file in folder and copies data on sheet to mainworkbook 'Sheet2'. The .csv name files consists one sheet & name always differ in folder.




How do I incorporate open all .csv files in folder?
How & where do I add loop to execute through each .csv file main code 'ScribeMainTEMPE'



Sub ImportData()


Dim wb1 As Workbook 'Main workbook running code
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range

Set wb1 = ActiveWorkbook
Set PasteStart = [Sheet2!A1]

FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.csv (*.csv),")
.AllowMultiSelect = False
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Set wb2 = Workbooks.Open(FileName:=FileToOpen)

For Each Sheet In wb2.Sheets
With Sheet.UsedRange
.Copy PasteStart
Set PasteStart = PasteStart.Offset(.Rows.Count)
End With
Next Sheet
End If
wb2.Close
End Sub


Thanks
weenie

[weenie]

The following line above:
.AllowMultiSelect = False

Is not in my working code for opening one file at a time. This was an accidental paste so line can be ignored

thanks,
weenie

[weenie]

Looks like I figured this out browsing other threads & web. Appears all files are opening & looping code with no errors & data doesn't look suspect:


Sub SelectOpenCopy()
Dim vaFiles As Variant
Dim i As Long
Dim wbkToCopy As Workbook
Dim wb2 As Workbook


Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False


Dim Sheet As Worksheet
Set wb2 = ActiveWorkbook

vaFiles = Application.GetOpenFilename("CSV Files (*.csv), *.csv", _
Title:="Select files", MultiSelect:=True)

If IsArray(vaFiles) Then
For i = LBound(vaFiles) To UBound(vaFiles)
Set wbkToCopy = Workbooks.Open(FileName:=vaFiles(i))
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
wb2.Activate
Sheets("Sheet2").Select
ActiveSheet.Paste

wbkToCopy.Close

Call ScribeMainTEMPE

Next i

End If
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True


MsgBox "Macro Finished."
End Sub

If anyone has better/faster methods please share :)

thanks,
weenie

[mdmackillop]

Please use the # button to add code tags,

Avoid selecting. Also, is it necesseary to call ScribeMainTEMPE within the loop or can it run on completion?
Your code looks as if it will overwrite previous entries. This should append below previous data.

For i = LBound(vaFiles) To UBound(vaFiles)
Set tgt = wb2.Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)(2)
Set wbkToCopy = Workbooks.Open(Filename:=vaFiles(i))
wbkToCopy.Sheet1.Range("A1").CurrentRegion.Copy tgt
wbkToCopy.Close
Call ScribeMainTEMPE
Next i

[weenie]

The code opens a file and executes 'ScribeMainTEMPE' which then needs to repeat process for all files in the folder. Placing the loop seemed to accomplish task. I'll double check this is not overwriting data. When I looked seemed to append below previous data. 'ScribeMainTEMPE' does have code line to append below previous data. Will definitely try code above which seems way shorter than mine.

Thanks,
weenie

[weenie]

wbkToCopy.Sheet1.Range("A1").CurrentRegion.Copy tgt

error stops at this line of code. The files opening do not have 'sheet1'. The sheet name is file name. The file names vary so can not hardcode sheet name.
1) What would I use in place of 'sheet1' since name varies?

Thanks,
weenie

[mdmackillop]

After testing

Sub SelectOpenCopy()
Dim vaFiles As Variant
Dim i As Long
Dim wbkToCopy As Workbook
Dim wb2 As Workbook
Dim tgt As Range

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim Sheet As Worksheet
Set wb2 = ActiveWorkbook

vaFiles = Application.GetOpenFilename("CSV Files (*.csv), *.csv", _
Title:="Select files", MultiSelect:=True)

If IsArray(vaFiles) Then
For i = LBound(vaFiles) To UBound(vaFiles)
Set wbkToCopy = Workbooks.Open(Filename:=vaFiles(i))
Range("A1").CurrentRegion.Copy wb2.Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)(2)
wbkToCopy.Close
Call ScribeMainTEMPE
Next i
End If
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

MsgBox "Macro Finished."
End Sub

[weenie]

Thank you. It worked. I did change the last number to (1).

Range("A1").CurrentRegion.Copy wb2.Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)(2)

it was dropping into row 2. I needed to drop in row 1

Thanks,
weenie

[mdmackillop]

The last (2) was to ensure pasting below previously pasted text. If you don't require that then change it to

Range("A1").CurrentRegion.Copy wb2.Sheets("Sheet2").Cells(1, 1)