jqagsweb
11-11-2016, 05:45 AM
Ive had this macro working at different points and this was now not working on a 64bit office copy but was on a 32bit, is Ive changed it up yet again, but cannot get it to work
Everyday multiple POs come in with orders on them one line at a time. Those files all are named PO_Data*.xlsx which includes the identifying number of that PO
The end workbook is not stored in the same directory and it is named Print-master.xlsm
All of these PO's are stored in the orders folder in the users download directory with nothing else in the folder
Everything in this macro works except it is now not importing the file contents at all
I have everything auto filling down to row 150 and not the last row used but I can address that at a later time. Not importing makes it worthless
At this point the more I mess with it the more screwed up Im making it.
Any assistance is appreciated.
Sub MergeWOrders()
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer
RowofCopySheet = 2 ' Row Number from where you wish to start copying
ThisWB = ActiveWorkbook.Name
Sheets("WOrders").Select
Range("a2:ac150").Select
Selection.Delete Shift:=xlUp
'Path = ("USERPROFILE") & "\Downloads\orders"
ChDir Environ("USERPROFILE") & "\Downloads\"
sFile = Dir("orders")
Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "PO_Data*.xlsx", vbNormal)
'If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
Set Dest = shtDest.Range("B" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy Dest
Wkb.Close False
End If
Filename = Dir()
Loop
'insert helper column
Range("A2").Select
ActiveCell.FormulaR1C1 = "1"
Range("A3").Select
ActiveCell.FormulaR1C1 = "2"
Range("A2:A3").Select
Selection.AutoFill Destination:=Range("A2:A150"), Type:=xlFillDefault
Range("A2:A150").Select
're-insert appropriate formulas
Sheets("WOrders").Select
Range("AD2").Select
ActiveCell.FormulaR1C1 = "=RC[-19]&"", ""&RC[-18]&"" ""&RC[-17]"
Range("AD2").Select
Selection.AutoFill Destination:=Range("AD2:AD150"), Type:=xlFillDefault
Range("AD2:AD150").Select
Range("AE2").Select
ActiveCell.FormulaR1C1 = "=RC[-14]&"" - ""&RC[-11]"
Range("AE2").Select
Selection.AutoFill Destination:=Range("AE2:AE150"), Type:=xlFillDefault
Range("AE2:AE150").Select
Sheets("Control Panel").Select
Range("A1").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "PO's Merged & Ready to batch Print"
End Sub
Everyday multiple POs come in with orders on them one line at a time. Those files all are named PO_Data*.xlsx which includes the identifying number of that PO
The end workbook is not stored in the same directory and it is named Print-master.xlsm
All of these PO's are stored in the orders folder in the users download directory with nothing else in the folder
Everything in this macro works except it is now not importing the file contents at all
I have everything auto filling down to row 150 and not the last row used but I can address that at a later time. Not importing makes it worthless
At this point the more I mess with it the more screwed up Im making it.
Any assistance is appreciated.
Sub MergeWOrders()
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer
RowofCopySheet = 2 ' Row Number from where you wish to start copying
ThisWB = ActiveWorkbook.Name
Sheets("WOrders").Select
Range("a2:ac150").Select
Selection.Delete Shift:=xlUp
'Path = ("USERPROFILE") & "\Downloads\orders"
ChDir Environ("USERPROFILE") & "\Downloads\"
sFile = Dir("orders")
Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "PO_Data*.xlsx", vbNormal)
'If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
Set Dest = shtDest.Range("B" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy Dest
Wkb.Close False
End If
Filename = Dir()
Loop
'insert helper column
Range("A2").Select
ActiveCell.FormulaR1C1 = "1"
Range("A3").Select
ActiveCell.FormulaR1C1 = "2"
Range("A2:A3").Select
Selection.AutoFill Destination:=Range("A2:A150"), Type:=xlFillDefault
Range("A2:A150").Select
're-insert appropriate formulas
Sheets("WOrders").Select
Range("AD2").Select
ActiveCell.FormulaR1C1 = "=RC[-19]&"", ""&RC[-18]&"" ""&RC[-17]"
Range("AD2").Select
Selection.AutoFill Destination:=Range("AD2:AD150"), Type:=xlFillDefault
Range("AD2:AD150").Select
Range("AE2").Select
ActiveCell.FormulaR1C1 = "=RC[-14]&"" - ""&RC[-11]"
Range("AE2").Select
Selection.AutoFill Destination:=Range("AE2:AE150"), Type:=xlFillDefault
Range("AE2:AE150").Select
Sheets("Control Panel").Select
Range("A1").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "PO's Merged & Ready to batch Print"
End Sub