Merging one sheet from Multiple Workbooks with Headings

[dropdaboom]

Is there a way to only copy over column headings once, so I don't need to go back and remove the extra copied headings? The sheets all have the same column heading, but I only need it to copy over once on the consolidated sheet.

thanks for any help


Public Sub MergeWorkbooks() Const ROOT_FOLDER As String = "C:\Users\DJ0E\Desktop\excel\"
Dim wbTarget As Workbook
Dim Filename As String
Dim filenames As Variant
Dim numrows As Long
Dim nextrow As Long

Set wbTarget = Workbooks.Add

Filename = Dir(ROOT_FOLDER & "*.xls*")
ReDim filenames(1 To 1)

nextrow = 1
Do While Filename <> ""

Workbooks.Open ROOT_FOLDER & Filename
With ActiveWorkbook

With .Worksheets("Inventory Sept Template")

numrows = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(2).Resize(numrows).Copy wbTarget.Worksheets(1).Cells(nextrow, "A")
nextrow = nextrow + numrows
End With

.Close SaveChanges:=False
End With

Filename = Dir
Loop

'do something with wbTarget
End Sub

[SamT]

Option Explicit

Public Sub MergeWorkbooks()
Const ROOT_FOLDER As String = "C:\Users\DJ0E\Desktop\excel\"
Dim wbTarget As Workbook
Dim Filename As String
Dim numrows As Long
Dim nextrow As Long
Dim HasHeader As Boolean

Set wbTarget = Workbooks.Add

Filename = Dir(ROOT_FOLDER & "*.xls*")
nextrow = 2

Do While Filename <> ""
Workbooks.Open ROOT_FOLDER & Filename

With ActiveWorkbook.Worksheets("Inventory Sept Template")
If Not HasHeader Then
Rows(1).Copy wbTarget.Worksheets(1).Range("A1")
HasHReader = True
End If
numrows = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(2).Resize(numrows).Copy wbTarget.Worksheets(1).Cells(nextrow, "A")
nextrow = nextrow + numrows

Parent.Close SaveChanges:=False
End With

Filename = Dir
Loop

'do something with wbTarget
End Sub