Kaustubh
10-16-2019, 05:20 AM
Hello Friends
I am having 100 files with more than 1 lakhs row each. I am looking for a macro to consolidate few selected column from each of these files.
This macro needs to be run on a separate excel file consisting column name. Next, open each file within a given folder and find the relevant column by its name. Once you find the column, copy the entire column and paste it under relevant file.
Currently the below code is working perfectly but it will consolidate the different worksheets not files.
Sub CopyHeaders()
Dim header As Range, headers As Range
Dim ws2 As Worksheet
Dim Template As Worksheet
Dim cell As Range
For Each ws2 In ActiveWorkbook.Worksheets
If IsError(Application.Match(ws2.Name, _
Array("Template","Sheet1"),0))Then
Set Rng = ws2.UsedRange
For Each cell In Rng
If cell.Value =""Then cell.Value ="0"
Next
Set headers = ws2.Range("A1:Z1")
For Each header In headers
If GetHeaderColumn(header.Value)>0Then
Range(header.Offset(1,0), header.End(xlDown)).Copy Destination:=Worksheets("Template").Cells(2, GetHeaderColumn(header.Value)).End(xlDown).End(xlUp).Offset(1,0)
End If
Next
End If
Next
End Sub
Function GetHeaderColumn(header AsString)AsInteger
Dim headers As Range
Set headers = Worksheets("Template").Range("A1:Z1")
GetHeaderColumn = IIf(IsNumeric(Application.Match(header, headers,0)), Application.Match(header, headers,0),0)
EndFunction
Source: https://stackoverflow.com/questions/40863725/match-column-headers-and-merge-worksheets
Please help in modifying this code for consolidating different excel files not worksheets.
I am having 100 files with more than 1 lakhs row each. I am looking for a macro to consolidate few selected column from each of these files.
This macro needs to be run on a separate excel file consisting column name. Next, open each file within a given folder and find the relevant column by its name. Once you find the column, copy the entire column and paste it under relevant file.
Currently the below code is working perfectly but it will consolidate the different worksheets not files.
Sub CopyHeaders()
Dim header As Range, headers As Range
Dim ws2 As Worksheet
Dim Template As Worksheet
Dim cell As Range
For Each ws2 In ActiveWorkbook.Worksheets
If IsError(Application.Match(ws2.Name, _
Array("Template","Sheet1"),0))Then
Set Rng = ws2.UsedRange
For Each cell In Rng
If cell.Value =""Then cell.Value ="0"
Next
Set headers = ws2.Range("A1:Z1")
For Each header In headers
If GetHeaderColumn(header.Value)>0Then
Range(header.Offset(1,0), header.End(xlDown)).Copy Destination:=Worksheets("Template").Cells(2, GetHeaderColumn(header.Value)).End(xlDown).End(xlUp).Offset(1,0)
End If
Next
End If
Next
End Sub
Function GetHeaderColumn(header AsString)AsInteger
Dim headers As Range
Set headers = Worksheets("Template").Range("A1:Z1")
GetHeaderColumn = IIf(IsNumeric(Application.Match(header, headers,0)), Application.Match(header, headers,0),0)
EndFunction
Source: https://stackoverflow.com/questions/40863725/match-column-headers-and-merge-worksheets
Please help in modifying this code for consolidating different excel files not worksheets.