dropdaboom
11-18-2015, 12:10 PM
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
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