Still need help on Macro

[MWhaley]

If you would look at my post down below, it's titled Need Macro Help please.

 

[Don Guillett]

You should stay in the ORIGINAL thread and have a bit of patience. Or,

If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.

 

[Joel]

Try these changes. It will automatically add sheet1 and sheet2 into the
PALLET workbooks

Sub test()

Folder = "H:\Inventory Control\HDD SCRAP\HDD SCRAP FOLDER 2009\" & _
"Shipped Pallets\2nd Qtr\"

Set HardDrivebk = Workbooks("Hard Drive test.xls")

FName = Dir(Folder & "*.xls")
Do While FName <> ""
Set bk = Workbooks.Open(Filename:=Folder & FName)

With bk
'add sheet 1 and sheet 2 to bk
Set NewSht1 = .Sheets.Add(before:=Sheets(1))
NewSht1.Name = "Sheet1"
Set NewSht2 = .Sheets.Add(after:=Sheets(1))
NewSht2.Name = "Sheet2"

.Sheets("W.Digital Pallet 5").Select
Application.Run "'Hard Drive test.xls'!Macro3"

With bk.Sheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set CopyRange = .Range("A1" & LastRow)
End With

With HardDrivebk.Sheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
CopyRange.Copy Destination:=.Range("A" & NewRow)
End With
.Close savechanges:=False
End With
FName = Dir()
Loop
End Sub

 

[MWhaley]

That works great, Thanks Joel

Try these changes. It will automatically add sheet1 and sheet2 into the
PALLET workbooks

Sub test()

Folder = "H:\Inventory Control\HDD SCRAP\HDD SCRAP FOLDER 2009\" & _
"Shipped Pallets\2nd Qtr\"

Set HardDrivebk = Workbooks("Hard Drive test.xls")

FName = Dir(Folder & "*.xls")
Do While FName <> ""
Set bk = Workbooks.Open(Filename:=Folder & FName)

With bk
'add sheet 1 and sheet 2 to bk
Set NewSht1 = .Sheets.Add(before:=Sheets(1))
NewSht1.Name = "Sheet1"
Set NewSht2 = .Sheets.Add(after:=Sheets(1))
NewSht2.Name = "Sheet2"

.Sheets("W.Digital Pallet 5").Select
Application.Run "'Hard Drive test.xls'!Macro3"

With bk.Sheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set CopyRange = .Range("A1" & LastRow)
End With

With HardDrivebk.Sheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
CopyRange.Copy Destination:=.Range("A" & NewRow)
End With
.Close savechanges:=False
End With
FName = Dir()
Loop
End Sub