Integrate multiple filesd in a specific directory to one worksheet in a separate file

[jqagsweb]

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

[Kenneth Hobs]

Please paste code between code tags. Insert code tags by clicking the # icon on the toolbar of a reply.

You have several things that could be improved. First, you need to resolve the path issue. After running this, check VBE's Immediate window for found filenames if any. If the window is not in view, select the option in VBE's View menu.

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 Long, glb_origCalculationMode As Integer
  
  On Error GoTo EndSub
  With Application
    glb_origCalculationMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    .Cursor = xlWait
    .StatusBar = "Processing Order files.."
    .EnableCancelKey = xlErrorHandler
  End With
  
  path = Environ("USERPROFILE") & "\Downloads\orders\"
  If Len(Dir(path, vbDirectory)) = 0 Then
    path = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\" _
      & "Explorer\User Shell Folders\{374DE290-123F-4565-9164-39C4925E467B}"
    With CreateObject("WScript.Shell")
      path = .ExpandEnvironmentStrings(.RegRead(path) & "\orders\")
    End With
  End If
  If Len(Dir(path, vbDirectory)) = 0 Then
    MsgBox "Downloads\Orders path could not be found.", vbCritical, "Macro Ending"
    GoTo EndSub
  End If
  
  Filename = Dir(path & "PO_Data*.xlsx", vbNormal)
  If Len(Filename) = 0 Then
    MsgBox "No PO_Data*.xlsx file could be found.", vbCritical, "Macro Ending"
    GoTo EndSub
  End If
  
  Do Until Filename = vbNullString
    Debug.Print Filename
    Filename = Dir()
  Loop


EndSub:
  With Application
    .Calculation = glb_origCalculationMode
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    .CalculateBeforeSave = True
    .Cursor = xlDefault
    .StatusBar = False
    .EnableCancelKey = xlInterrupt
  End With
End Sub