Printable View
Hi Team,
I need a macro which opens the files from given path and copy and paste the contents in one file.
For example I have 30 files in a folder and the path is mentioned in macro file, Using the given path macro will consolidate the data in a file.In case if one file is missing out of 30 it should go to next file...
Please help me in this regard.
Regards,
Ravi.C
You might want to give a little more detail. Are all these files Excel files? Do you want to consolidate them in to a single Excel file (in one worksheet, or multiple worksheets)? Do you want to copy the entire content? Should the headers be copied all the time if they are available?
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=TW3l7PkSPD4&lc=UgwAL_Jrv7yg7WWC8x14AaABAg
https://www.youtube.com/watch?v=zHJPliWS9FQ&lc=Ugz39PGfytiMUCmTPTl4AaABAg. 91d_Pbzklsp9zfGbIr8hgW
https://www.youtube.com/watch?v=zHJPliWS9FQ&lc=UgwbcybM8fXnaIK-Y3B4AaABAg.97WIeYeaIeh9zfsJvc21iq
https://www.youtube.com/watch?v=vSjTzhoJFdk&lc=UgzTC8V4jCzDHbmfCHF4AaABAg. 9zaUSUoUUYs9zciSZa959d
https://www.youtube.com/watch?v=vSjTzhoJFdk&lc=UgzTC8V4jCzDHbmfCHF4AaABAg. 9zaUSUoUUYs9zckCo1tvPO
https://www.youtube.com/watch?v=vSjTzhoJFdk&lc=UgwMsgdKKlhr2YPpxXl4AaABAg
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgwTUdEgR4bdt6crKXF4AaABAg. 9xmkXGSciKJ9xonTti2sIx
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgwWw16qBFX39JCRRm54AaABAg. 9xnskBhPnmb9xoq3mGxu_b
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgzgWvzV-kvC4TJ8O414AaABAg.9xnFzCj8HRM9xon1p2ImxO
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgybZfNJd3l4FokX3cV4AaABAg. 9xm_ufqOILb9xooIlv5PLY
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgzgWvzV-kvC4TJ8O414AaABAg.9xnFzCj8HRM9y38bzbSqaG
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgyWm8nL7syjhiHtpBF4AaABAg. 9xmt8i0IsEr9y3FT9Y9FeM
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
Hi,Quote:
Originally Posted by Excel Fox
Yes all files are excel files, and i want a consolidated data in one worksheet including the Headers.i.e all contents of the files.
Regards,
Ravi.C
Hi Ravi,
Try this one. Adjust sheet name.
Code:Dim dic As Object
Dim Counter As Long
Sub kTest()
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"
'// 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 50000, 1 To 100)
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 = 2 To UBound(d, 1) 'skips header
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
1. Is the structure for each file identical (same headers in the same order)?Quote:
Originally Posted by ravichandavar
2. Do all the files consist of only a single worksheet each?
3. Is the order the files are consolidated in important (in other words, is the final order of the data important)?
4. The Headers... are the all on Row 1 only?
Quote:
Originally Posted by Rick Rothstein
Hi Rick,
Yes,all the points you mentioned above is right.
Regards,
Ravi.C
Hi ,
Thanks for the quick reply.I just copied the codes you have provided it runs fine but I'm not able to get the consolidated data in one file.
Where these data are getting copied and one more thing is i need data from first sheet of every file in the folder in a sheet.
Thanks & Regards,
Ravi.C
Hi Ravi,
Have you changed the required changes in the code?
By default it consolidates all the data in Sheet1 of the workbook where you placed the code.
Hi Yes,
I did that but still its not working.One more thing Suppose my folder contain 3 or 4 files and from these files data from second file should come down the data's of first file subsequently 3d and forth.
For example: Files of the folder contains data in A1:T100 And i need to paste this in my consolidation file as A1:T100 contains first file data and A101 to T200 should take data from second file and so on...
Hope you might have understood my requirement.
Please find the attached file....
No. You didn't.Quote:
Originally Posted by ravichandavar
Place the following 2 lines outside the procedure like I posted above.
and try to run again.Code:Dim dic As Object
Dim Counter As Long
Hi,
Thanks for quick reply.I have tried that too, but macro runs fine and opens all the file but result is zero. I don't know where all the data s are copied.
Please find the file which i tried once again and let me know do i need to change anything in this code.
Thanks & Regards,
Ravi.C
Hi
Attach one source file as well.
Quote:
Originally Posted by ravichandavar
Hi,
For me it works.
All files you want to copy must have the same header and be placed in the same place. I used your file, without modification.
It should work even if the headers are in different place.
Quote:
Originally Posted by Admin
Yes, headers can be in any position but in the same range, say A1: L1, if headers are (even if they are the same in all pages) say D5: P5 code does not work. If file 1, 2...10 has header in range A1:L1 and in file 11 the header is in D5:P2, cod don't work.
Adjusting this line would do the trick.
rather than taking the current region you can explicitly put the range.Code:d = .Range("a1").CurrentRegion.Value2
Quote:
Originally Posted by Admin
Yes you are right.
I am referring to the following situation:
if in file 1 to 5 are header in the range A1: F1 and data in A2: F25, and the file 6 the header is in the range I5: N5 and data in I6: N30 when run the code, error appears in line For i = LBound (DataHeader) To UBound (DataHeader)