Sort data from every workbook in a folder into sheets in another?

L

leveleyed

I have a workbook named RetailClientTemplate which contains sheets named by
locale abbreviation (EN, ES, DE, IT, etc.). I have workbooks named
RetailProjectLog_DATE generated each day that are saved into a specific
folder location. Each row in each RPL workbook has a locale in column A that
matches the name of one of the sheets in the RCT workbook. What I need to do
is make a macro that will copy & paste the rest of the data from each row in
each of the RPL books (sheet1, range B4:Q200, and col P data separately) in
the specified folder into the corresponding sheet for each locale in the RCT
workbook (row by row, starting at A12:p12, and data from col P in RPL into
col Y in RCT). How can this be done? And is it possible to do it without
visibly opening each of the RPL workbooks top copy the data from them? Please
help. The boss is really breathing down my neck on this one and I can't
figure it out! Thank you!
 
J

joel

Yo ucan get data out of a workbook without opening each workbook bu
that is much harder to write that code and since you boss is breathinh
down your neck I would recommend the code below. Changge the folde
name in the Code below. The code is taking every file in the Folde
named "RetailProjectLog*.xls" and ignoring the date. I would have t
mdofiy the code if you are looking for a particular date.


Sub UpdateRCTBks()

Folder = "c:\temp\"
FName = Dir(Folder & "RetailProjectLog*.xls")
Do While FName <> ""
Set RPLbk = Workbooks.Open(Filename:=Folder & FName)
Set RPLSht = RPLbk.Sheets("Sheet1")
LastRow = RPLSht.Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 4 To LastRow
Locale = RPLSht.Range("A" & RowCount)
Set DestSht = ThisWorkbook.Sheets(Locale)
With DestSht
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
If NewRow < 12 Then
NewRow = 12
End If
End With

RPLSht.Range("B" & RowCount & ":Q" & RowCount).Copy
DestSht.Range("A" & NewRow).PasteSpeial _
Paste:=xlPasteValues

RPLSht.Range("P" & RowCount).Copy
DestSht.Range("Y" & NewRow).PasteSpeial _
Paste:=xlPasteValues

Next RowCount

RPLbk.Close savechanges:=True
FName = Dir()
Loop

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top