Sub to stack data n paste unique order ID lines
Hi,
Here are 2 subs. The first creates your new workbook and opens each of the
four workbooks in turn. It then calls the second sub.
The second sub does the copying and pasting from 1.xls etc to 1234.xls.
Note i included no error checking so if 1234.xls already exists you get an
error, I have assumed a single sheet in each of the 4 workbooks opened.
You will need to set MyPath to the correct path
Sub LoopThroughDirectory()
Application.DisplayAlerts = False
'Change this to your directory
MyPath = "C:\"
Dim wbNew As Workbook
Set wbNew = Workbooks.Add()
wbNew.SaveAs Filename:=MyPath & "1234.xls"
For x = 1 To 4
Workbooks.Open Filename:=MyPath & x & ".xls"
'Here is the line that calls the macro below, passing the workbook to it
DoSomething ActiveWorkbook
ActiveWorkbook.Close savechanges:=False
Next
Application.DisplayAlerts = True
End Sub
Sub DoSomething(Book As Workbook)
lastrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row
If ActiveWorkbook.Name = "1.xls" Then
ActiveSheet.Rows("1:" & lastrow).Copy
Else
ActiveSheet.Rows("2:" & lastrow).Copy
End If
lastrowNew = Windows("1234.xls").ActiveSheet.Cells(Cells.Rows.C ount,
"B").End(xlUp).Row
Windows("1234.xls").ActiveSheet.Range("A" & lastrowNew).PasteSpecial
End Sub
Mike
"Max" wrote:
Looking for help for a sub to do this: Stack up identical structure data from
4 source files, then paste unique lines (based on "order id" col) into a new
sheet
I would run this sub from Personal.xls,
navigate to a folder, where there would be 4 files:
1.xls
2.xls
3.xls
4.xls
Each file contains only 1 sheet with data (sheetnames may vary from day to
day and are to be disregarded). The data in all 4 files are identical in
structure, with col headers in row 1, data from row2 down. Col B is used to
determine data extent.
The sub will create a new book, name it as simply: 1234.xls, save it into
the same folder as the source files, then copy n paste (stack up) entire data
rows from each of the 4 source files into Sheet1 (with col headers pasted
into row 1)
Then the sub will carve out uniques based on the "Order ID" col header, and
paste these unique lines into a new sheet, naming this new sheet as:
UniqueOrderIDs
|