Meger multiple file but header not same
Hi
I want to consolidated the multiple exel files from folder but header of excel files in folder is different and this macro showing error.
I will be thankful to you if you provide me the modify macro. I am new to macro.
i
Quote:
Originally Posted by
Admin
Hi All,
Here is sub which will consolidate multiple workbooks from a single folder into a master workbook.
It even handles the different col headers while consolidating.
Code:
Dim dic As Object
Dim Counter As Long
Sub ConsolidateWorkbooks()
Dim r As Long
Dim c As Long
Dim n As Long
Dim j As Long
Dim Fldr As String
Dim Fname As String
Dim wbkActive As Workbook
Dim wbkSource As Workbook
Dim Dest As Range
Dim d, k()
'// User settings
Const SourceFileType As String = "xls*" 'xls,xlsx,xlsb,xlsm
Const DestinationSheet As String = "Sheet1"
Const DestStartCell As String = "A1"
Const MaxRows As Long = 50000
Const MaxCols As Long = 100
Const StartRow As Long = 2
'// End
Application.ScreenUpdating = False
Counter = 0
With Application.FileDialog(4)
.Title = "Select source file folder"
.AllowMultiSelect = False
If .Show = -1 Then
Fldr = .SelectedItems(1)
Else
GoTo Xit
End If
End With
Set dic = CreateObject("scripting.dictionary")
dic.comparemode = 1
Set wbkActive = ThisWorkbook
ReDim k(1 To MaxRows, 1 To MaxCols)
Set Dest = wbkActive.Worksheets(DestinationSheet).Range(DestStartCell)
Fname = Dir(Fldr & "\*." & SourceFileType)
Do While Len(Fname)
If wbkActive.Name <> Fname Then
Set wbkSource = Workbooks.Open(Fldr & "\" & Fname)
With wbkSource.Worksheets(1)
d = .Range("a1").CurrentRegion
UniqueHeaders Application.Index(d, 1, 0)
For r = StartRow To UBound(d, 1)
If Len(d(r, 1)) Then
n = n + 1
For c = 1 To UBound(d, 2)
If Len(Trim$(d(1, c))) Then
j = dic.Item(Trim$(d(1, c)))
k(n, j) = d(r, c)
End If
Next
End If
Next
Erase d
End With
wbkSource.Close 0
Set wbkSource = Nothing
End If
Fname = Dir()
Loop
If n Then
Dest.Resize(, dic.Count) = dic.keys
Dest.Offset(1).Resize(n, dic.Count) = k
MsgBox "Done", vbInformation, "ExcelFox.com"
End If
Xit:
Application.ScreenUpdating = True
End Sub
Private Sub UniqueHeaders(ByRef DataHeader)
Dim i As Long
Dim j As Long
With Application
j = .ScreenUpdating
.ScreenUpdating = False
End With
For i = LBound(DataHeader) To UBound(DataHeader)
If Len(Trim$(DataHeader(i))) Then
If Not dic.exists(Trim$(DataHeader(i))) Then
Counter = Counter + 1
dic.Add Trim$(DataHeader(i)), Counter
End If
End If
Next
Application.ScreenUpdating = j
End Sub
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
Meger multiple file but header not same
Hi
The error I getting is
Run-time error '13'
Type mismatch
When I click on debug the following line getting an error.
UniqueHeaders Application.Index(d, 1, 0)
However I have identify that header in some of excel sheet is not same but I need to consolidated the data from all workbook. Please help me.
Quote:
Originally Posted by
Admin
Hi rocky,
Welcome to ExcelFox!!
Please explain what kind of error you got and at which line ?
Meger multiple file but header not same
The header is in the first row of all workbook but heading is different in some of workbook.
I have pasted updated line of coding but again getting following error:-
Runt-time error '9'
subcript out of range
Below is line of error
k(n, j) = d(r, c)
Quote:
Originally Posted by
Admin
If it's not in the first row, how we can identify that in which row the header is ?
In the meantime place these line above the error line.
Code:
Do While Application.WorksheetFunction.CountA(.Rows(1)) = 0
.Rows(1).Delete
Loop
Meger multiple file but header not same
Answer is 0
Quote:
Originally Posted by
Admin
before the error line write
and see what is the number in the immediate window (Ctrl + G) when the error comes in.
Mege multiple file but header not same
I cannot upload the file. Can you modify the macro coding so that I can copy data from all workbook in folder range A2:AS2 to end of the row.(copy the data without header)
You can upload the workbooks by clicking 'Go Advanced' and then 'manage attachments'[/QUOTE]
Merge multiple file but header not same
Thanks buddy, now it is working....
Merge multiple file but header not same
Hi
I have run this macro and it is working fine. But there is blank row coming in consolidated sheet after sheet data. For example one workbook data is pasted in consolidated sheet and then one row left blank. Then second workbook data is pasted and then one row blank. There thirty row leave blank because thirty file to consolidate.
Seondly the formating of sheet is not proper way. Is there any way to consolidate the data as value so that cell size does not change.
Quote:
Originally Posted by
rocky
Thanks buddy, now it is working....
Merge multiple file but header not same
Hi
I am getting the following error again and again
There is large amount of information on the Clipboard. Do you want to be able to paste this information into another programe later.
To save it on the Clipboard so that you can paste it later, click Yes
To delete if from the Clipboard and free memory, click no.
