bobrandom123
New Member
- Joined
- Apr 19, 2012
- Messages
- 11
Hey everyone,
I've been working with the following script to take a series of .csv files and combine them into one .xls workbook utilizing Excel 2007. It works great but the problem is that all of the headers in the series are the same. How may I modify this script to include the headers on the first workbook imported but omit the headers from the remaining files?
I appreciate your help
I've been working with the following script to take a series of .csv files and combine them into one .xls workbook utilizing Excel 2007. It works great but the problem is that all of the headers in the series are the same. How may I modify this script to include the headers on the first workbook imported but omit the headers from the remaining files?
I appreciate your help
Code:
Sub CombineWorksheets()
Dim fName As String, fPath As string, fPathDone As Strong, OldDir As String
Dim LR As Long, NR As Long
Dim wbkOld As Workbook, wbkNew As Workbook, WS As Worksheet
'Setup
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Set wbkNew = ThisWorkbook
wbkNew.Activate
Sheets("Sheet1").Activate
If MsgBox("Import new data to this report?". vbYesNo) = vbNo Then Exit Sub
NR = Range("A" & Rows.Count).End(xlUp).Row + 1
OldDir = CurDir
'Where csv files to be combined are located
fPath = "C:\Documents and Settings\Administrator\Desktop\Example\"
'Where csv files are moved to once combined in this master sheet
fPathDone = "C:\Documents and Settings\Administrator\Desktop\Example\Imported\"
ChDir fPath
fName = Dir("*.csv")
'Import a sheet from found file
Do while Len(fName) > 0
'Open file
Set wbkOld = Workbooks.Open(fName)
'Find last row and copy data
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:A" & LR).EntireRow.Copy _
wbkNew.Sheets("Sheet1").Range("A" & NR)
'Close file
wbkOld.Close True
'Next row
NR = Range("A" & Rows.Count).End(xlUp).Row + 1
'Move file to converted folder
Name fPath & fName As fPathDone & fName
'Ready next filename
fName = DirLoop
'Cleanup
ActiveSheet.Columns.AutoFit
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
'Restores users original working path
ChDir OldDir
End Sub