Option Base 1

Sub CQCard_Process()
Application.ScreenUpdating = False
Dim myArray As Variant
Dim Mycount As Long
Dim CurFile As String
Dim Destwb As Workbook
Dim rng As Range
Dim mydt As String
Dim lrow As Long
Dim Onr As String
Dim sFileName As String
myArray = Array("OrderNr.", "FileNr", "Indent", "Date Of Order")
lrow = Range("A" & Rows.Count).End(xlUp).Row

Const DirLoc As String = "C:\QCCard\"


CurFile = Dir(DirLoc & "*.XLSX")
''' CHeck to see if you have QCCards to process.'''
If CurFile = "" Then
    MsgBox "You do not have QC Cards to process!"
    Exit Sub
End If
Do While CurFile <> vbNullString ''' we open new workbook tehn populate it with the data
    CurFile = Dir(DirLoc & "*.XLSX")
    If CurFile = "" Then Exit Sub
    Dim Origwb As Workbook
    Set Destwb = Workbooks.Add
    Set Origwb = Workbooks.Open(Filename:=DirLoc & CurFile) ''Here we open each workbook in the file
    '''  Populate the data to new workbook '''
    With Origwb
        .Sheets("Table 1").Range("AC8").WrapText = False
        .Sheets("Table 1").Range("AC3").WrapText = False
        .Sheets("Table 1").Range("v2").WrapText = False
        .Sheets("Table 1").Range("c1").WrapText = False
        .Sheets("Table 1").Range("AC8").MergeCells = False
        .Sheets("Table 1").Range("AC3").MergeCells = False
        .Sheets("Table 1").Range("v2").MergeCells = False
        .Sheets("Table 1").Range("c1").MergeCells = False
    End With
   Destwb.Activate
    Set rng = ActiveSheet.Range("A1:D1")
    With Destwb
        With Worksheets("Sheet1")
            For Mycount = 1 To UBound(myArray)
                .Cells(1, Mycount).Value = myArray(Mycount)
            Next Mycount
        End With
        Origwb.Sheets("Table 1").Range("AC8").Value = Replace(Right(Origwb.Sheets("Table 1").Range("AC8").Value, _
            Len(Origwb.Sheets("Table 1").Range("AC8").Value) - InStr(Origwb.Sheets("Table 1").Range("AC8").Value, Chr(10))), " ", "")
            
        Origwb.Sheets("Table 1").Range("AC3").Value = Replace(Right(Origwb.Sheets("Table 1").Range("AC3").Value, _
            Len(Origwb.Sheets("Table 1").Range("AC3").Value) - InStr(Origwb.Sheets("Table 1").Range("AC3").Value, Chr(10))), " ", "")
            
        Origwb.Sheets("Table 1").Range("c1").Value = Replace(Right(Origwb.Sheets("Table 1").Range("c1").Value, _
            Len(Origwb.Sheets("Table 1").Range("c1").Value) - InStr(Origwb.Sheets("Table 1").Range("c1").Value, Chr(10))), " ", "")
            
        Origwb.Sheets("Table 1").Range("v2").Value = Replace(Right(Origwb.Sheets("Table 1").Range("v2").Value, _
            Len(Origwb.Sheets("Table 1").Range("v2").Value) - InStr(Origwb.Sheets("Table 1").Range("v2").Value, Chr(10))), " ", "")
        mydt = Format(Origwb.Sheets("Table 1").Range("AC8").Value, "mm-dd-yy")
    
        .Sheets("Sheet1").Range("A2").Value = Trim(Mid(Origwb.Sheets("Table 1") _
            .Range("AC3").Value, InStr(1, Origwb.Sheets("Table 1").Range("Ac3").Text, " #") + 1)) '''order
            
        .Sheets("Sheet1").Range("B2").Value = Trim(Mid(Origwb.Sheets("Table 1") _
            .Range("V2").Value, InStr(1, Origwb.Sheets("Table 1").Range("V2").Text, " #") + 1))
            
        .Sheets("Sheet1").Range("C2").Value = Trim(Mid(Origwb.Sheets("Table 1") _
            .Range("C1").Value, InStr(1, Origwb.Sheets("Table 1").Range("C1").Text, ".") + 1)) '' Indent
            
        .Sheets("sheet1").Range("D2").Value = mydt ''' Date

        Title = Destwb.Sheets("Sheet1").Range("A2") & "_" & Destwb.Sheets("Sheet1") _
            .Range("B2") & "_" & mydt
            sFileName = "C:\QCCard\QCCompleted\" & Title
            ActiveWorkbook.SaveAs Filename:=sFileName ', FileFormat:=51
            ActiveWorkbook.Close SaveChanges:=True
            Application.EnableEvents = False
            '''''''' Move file to QCProcessed we will kill the original
            ActiveWorkbook.SaveAs "C:\QCCard\QCProcessed\" & Origwb.Name
            ActiveWorkbook.Close
            Kill "C:\QCCard\" & CurFile
            Application.EnableEvents = True
    End With
   ' Next i
  Loop
  Application.ScreenUpdating = True
  MsgBox "QCCard Run Complete"
End Sub