yashsrawat
Board Regular
- Joined
- Aug 11, 2006
- Messages
- 106
Hi Team
Need a help on excel sheets consolidation from Folders.
I have folders created by city name( Mumbai, Chennai, Agra etc) and these City folders have 4-5 worksheets with different header, which i need to consolidate one master sheet with data and header line of each worksheets.
I have code by which i am able to consolidate the files but this code not copy the header, if can we modfiy this code by which header lines of sheets also get copied in master sheet, it would be great help.
'Description: Combines all files in a folder to a master file.
Sub MergeFiles()
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer
RowofCopySheet = 2 ' Row to start on in the sheets you are copying from
ThisWB = ActiveWorkbook.Name
path = GetDirectory("Select a folder containing Excel files you want to merge")
Application.EnableEvents = False
Application.ScreenUpdating = False
Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "" & Filename)
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy Dest
Wkb.Close False
End If
Filename = Dir()
Loop
Range("A1").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
Need a help on excel sheets consolidation from Folders.
I have folders created by city name( Mumbai, Chennai, Agra etc) and these City folders have 4-5 worksheets with different header, which i need to consolidate one master sheet with data and header line of each worksheets.
I have code by which i am able to consolidate the files but this code not copy the header, if can we modfiy this code by which header lines of sheets also get copied in master sheet, it would be great help.
'Description: Combines all files in a folder to a master file.
Sub MergeFiles()
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer
RowofCopySheet = 2 ' Row to start on in the sheets you are copying from
ThisWB = ActiveWorkbook.Name
path = GetDirectory("Select a folder containing Excel files you want to merge")
Application.EnableEvents = False
Application.ScreenUpdating = False
Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "" & Filename)
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy Dest
Wkb.Close False
End If
Filename = Dir()
Loop
Range("A1").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub