Need Marco Help please
 

Ok the macro that I have is working great but it only does on file at a time.
What I'm wanting it to do is go through all the files in the Subfolder and do
the rest of the macro. But I also need workbook Hard Drive Test Sheet1 to add
the new data to the end of the data that is already there for example. Once
this Marco start this first paste will be from A1 to whatever let's say A290,
I need for it to start the next paste of the next workbook at A291. Here is
the macro as I've got it wrote now.

Thanks in advance for the help.

Workbooks.Open Filename:= _
"H:\Inventory Control\HDD SCRAP\HDD SCRAP FOLDER 2009\Shipped
Pallets\2nd Qtr\PALLET 14-02.xls"
Sheets("W.Digital Pallet 5").Select
Sheets.Add
Sheets("Sheet1").Select
Sheets.Add
Sheets("W.Digital Pallet 5").Select
Application.Run "'Hard Drive test.xls'!Macro3"
Sheets("Sheet1").Select
Columns("A:F").Select
Selection.Copy
Windows("Hard Drive test.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A1").Select
Range("A172").Select
Windows("PALLET 14-02.xls").Activate
ActiveWorkbook.Close
End Sub

Need Marco Help please
 

I can't tell why you needed to add two worksheets so I eliminated that codee
plus some other things that did nothing.

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)
'eliminate code that added an extra sheet
'Sheets("W.Digital Pallet 5").Select
'Sheets.Add

With bk
.Sheets("W.Digital Pallet 5").Select
Application.Run "'Hard Drive test.xls'!Macro3"
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set CopyRange = .Range("A1:D" & LastRow)

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" wrote:

Ok the macro that I have is working great but it only does on file at a time.
What I'm wanting it to do is go through all the files in the Subfolder and do
the rest of the macro. But I also need workbook Hard Drive Test Sheet1 to add
the new data to the end of the data that is already there for example. Once
this Marco start this first paste will be from A1 to whatever let's say A290,
I need for it to start the next paste of the next workbook at A291. Here is
the macro as I've got it wrote now.

Thanks in advance for the help.

Workbooks.Open Filename:= _
"H:\Inventory Control\HDD SCRAP\HDD SCRAP FOLDER 2009\Shipped
Pallets\2nd Qtr\PALLET 14-02.xls"
Sheets("W.Digital Pallet 5").Select
Sheets.Add
Sheets("Sheet1").Select
Sheets.Add
Sheets("W.Digital Pallet 5").Select
Application.Run "'Hard Drive test.xls'!Macro3"
Sheets("Sheet1").Select
Columns("A:F").Select
Selection.Copy
Windows("Hard Drive test.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A1").Select
Range("A172").Select
Windows("PALLET 14-02.xls").Activate
ActiveWorkbook.Close
End Sub

Need Marco Help please
 

Joel thanks a lot. It looks like it going to work except, when it runs Macro3
it loops because it doesn't have a sheet1 and sheet2 in them. That's why I
was adding them. Here is the code for Macro3 maybe you can help with it also.

Dim MyRange
Dim CopyrangeRetail As Range
Dim CopyrangeOpen As Range
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = Range("A1:A" & LastRow)
For Each C In MyRange
If UCase(Left(C.Value, 2)) = "WC" Then
If CopyrangeRetail Is Nothing Then
Set CopyrangeRetail = C.EntireRow
Else
Set CopyrangeRetail = Union(CopyrangeRetail, C.EntireRow)
End If
End If
If UCase(Left(C.Value, 2)) < "WO" Then
If CopyrangeOpen Is Nothing Then
Set CopyrangeOpen = C.EntireRow
Else
Set CopyrangeOpen = Union(CopyrangeOpen, C.EntireRow)
End If
End If
Next
If Not CopyrangeRetail Is Nothing Then
CopyrangeRetail.Copy Destination:=Sheets("sheet1").Range("A1")
End If
If Not CopyrangeOpen Is Nothing Then
CopyrangeOpen.Copy Destination:=Sheets("sheet2").Range("A1")
End If
End Sub

"Joel" wrote:

I can't tell why you needed to add two worksheets so I eliminated that codee
plus some other things that did nothing.

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)
'eliminate code that added an extra sheet
'Sheets("W.Digital Pallet 5").Select
'Sheets.Add

With bk
.Sheets("W.Digital Pallet 5").Select
Application.Run "'Hard Drive test.xls'!Macro3"
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set CopyRange = .Range("A1:D" & LastRow)

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" wrote:

Ok the macro that I have is working great but it only does on file at a time.
What I'm wanting it to do is go through all the files in the Subfolder and do
the rest of the macro. But I also need workbook Hard Drive Test Sheet1 to add
the new data to the end of the data that is already there for example. Once
this Marco start this first paste will be from A1 to whatever let's say A290,
I need for it to start the next paste of the next workbook at A291. Here is
the macro as I've got it wrote now.

Thanks in advance for the help.

Workbooks.Open Filename:= _
"H:\Inventory Control\HDD SCRAP\HDD SCRAP FOLDER 2009\Shipped
Pallets\2nd Qtr\PALLET 14-02.xls"
Sheets("W.Digital Pallet 5").Select
Sheets.Add
Sheets("Sheet1").Select
Sheets.Add
Sheets("W.Digital Pallet 5").Select
Application.Run "'Hard Drive test.xls'!Macro3"
Sheets("Sheet1").Select
Columns("A:F").Select
Selection.Copy
Windows("Hard Drive test.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A1").Select
Range("A172").Select
Windows("PALLET 14-02.xls").Activate
ActiveWorkbook.Close
End Sub

Need Marco Help please
 

After Macro3 is ran the data that is in Sheet1 of every workbook is what I'm
wanted copied to the Hard Drive Test workbook, if that's helps.

"MWhaley" wrote:

Joel thanks a lot. It looks like it going to work except, when it runs Macro3
it loops because it doesn't have a sheet1 and sheet2 in them. That's why I
was adding them. Here is the code for Macro3 maybe you can help with it also.

Dim MyRange
Dim CopyrangeRetail As Range
Dim CopyrangeOpen As Range
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = Range("A1:A" & LastRow)
For Each C In MyRange
If UCase(Left(C.Value, 2)) = "WC" Then
If CopyrangeRetail Is Nothing Then
Set CopyrangeRetail = C.EntireRow
Else
Set CopyrangeRetail = Union(CopyrangeRetail, C.EntireRow)
End If
End If
If UCase(Left(C.Value, 2)) < "WO" Then
If CopyrangeOpen Is Nothing Then
Set CopyrangeOpen = C.EntireRow
Else
Set CopyrangeOpen = Union(CopyrangeOpen, C.EntireRow)
End If
End If
Next
If Not CopyrangeRetail Is Nothing Then
CopyrangeRetail.Copy Destination:=Sheets("sheet1").Range("A1")
End If
If Not CopyrangeOpen Is Nothing Then
CopyrangeOpen.Copy Destination:=Sheets("sheet2").Range("A1")
End If
End Sub

"Joel" wrote:

I can't tell why you needed to add two worksheets so I eliminated that codee
plus some other things that did nothing.

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)
'eliminate code that added an extra sheet
'Sheets("W.Digital Pallet 5").Select
'Sheets.Add

With bk
.Sheets("W.Digital Pallet 5").Select
Application.Run "'Hard Drive test.xls'!Macro3"
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set CopyRange = .Range("A1:D" & LastRow)

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" wrote:

Ok the macro that I have is working great but it only does on file at a time.
What I'm wanting it to do is go through all the files in the Subfolder and do
the rest of the macro. But I also need workbook Hard Drive Test Sheet1 to add
the new data to the end of the data that is already there for example. Once
this Marco start this first paste will be from A1 to whatever let's say A290,
I need for it to start the next paste of the next workbook at A291. Here is
the macro as I've got it wrote now.

Thanks in advance for the help.

Workbooks.Open Filename:= _
"H:\Inventory Control\HDD SCRAP\HDD SCRAP FOLDER 2009\Shipped
Pallets\2nd Qtr\PALLET 14-02.xls"
Sheets("W.Digital Pallet 5").Select
Sheets.Add
Sheets("Sheet1").Select
Sheets.Add
Sheets("W.Digital Pallet 5").Select
Application.Run "'Hard Drive test.xls'!Macro3"
Sheets("Sheet1").Select
Columns("A:F").Select
Selection.Copy
Windows("Hard Drive test.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A1").Select
Range("A172").Select
Windows("PALLET 14-02.xls").Activate
ActiveWorkbook.Close
End Sub

Need Marco Help please
 

Joel,

This part is coming up with an error. It's doing the macro and now I'm
wanting to copy the data from the sheet1 in this workbook and add it to Hard
Drive test on sheet1. This will be the first paste. Once the second workbook
is opened and the marco runs then it will need to find the end of the data in
column A and start the paste at the first blank row.

"MWhaley" wrote:

Ok the macro that I have is working great but it only does on file at a time.
What I'm wanting it to do is go through all the files in the Subfolder and do
the rest of the macro. But I also need workbook Hard Drive Test Sheet1 to add
the new data to the end of the data that is already there for example. Once
this Marco start this first paste will be from A1 to whatever let's say A290,
I need for it to start the next paste of the next workbook at A291. Here is
the macro as I've got it wrote now.

Thanks in advance for the help.

Workbooks.Open Filename:= _
"H:\Inventory Control\HDD SCRAP\HDD SCRAP FOLDER 2009\Shipped
Pallets\2nd Qtr\PALLET 14-02.xls"
Sheets("W.Digital Pallet 5").Select
Sheets.Add
Sheets("Sheet1").Select
Sheets.Add
Sheets("W.Digital Pallet 5").Select
Application.Run "'Hard Drive test.xls'!Macro3"
Sheets("Sheet1").Select
Columns("A:F").Select
Selection.Copy
Windows("Hard Drive test.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A1").Select
Range("A172").Select
Windows("PALLET 14-02.xls").Activate
ActiveWorkbook.Close
End Sub