Weird Set Object and Copy Destination behaivour

Hello! I have a large piece of code below, so i highlighted the problem part. I'm curious, why there is nothing happening when i try to use Range.Copy Destination between Set worksheets in different workbooks. Everything is working fine but this red part. The weirdest thing is that it was working perfectly fine without border formatting part, however it stopped working after it, this function works good in the code below red. Also the side question - is there any obvious way to shorten the formatting or just overall code to make it run faster. Thanks in advance!

Sub Button1_Click()
   
    Dim sFolder As String
    Dim sFile As String
    
    Dim wbD As Workbook
    Dim wbS As Workbook
    
    Dim nSheet As Worksheet
    Dim dSheet As Worksheet
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False

    
    Set wbS = ThisWorkbook
    sFolder = wbS.Path & "\"
                                                                                                         'Loop processing all files
                                                                                                         'within masterfile folder
    sFile = Dir(sFolder)
    Do While sFile <> ""
        
        ActiveSheet.DisplayPageBreaks = False
        
        If sFile <> wbS.Name Then
            Set wbD = Workbooks.Open(sFolder & sFile)
            
                                                                                                         'Copying PMF list
            Set nSheet = wbD.Sheets.Add(Type:=xlWorksheet)
            nSheet.Name = "PMF"
            wbS.Sheets("PMF").Range("A:MP").Copy Destination:=nSheet.Range("A1")
            Cells.Replace What:="[*]", Replacement:="", LookAt:=xlPart, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            
                                                                                                         'Copying REL Scoring list
            Set nSheet = wbD.Sheets.Add(Type:=xlWorksheet)
            nSheet.Name = "REL Scoring"
            wbS.Sheets("REL Scoring").Range("A:MA").Copy Destination:=nSheet.Range("A1")
            Cells.Replace What:="[*]", Replacement:="", LookAt:=xlPart, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            
                                                                                                         'Modifying Summary
            Set nSheet = wbD.Sheets("Summary")
            Set dSheet = wbS.Sheets("Summary")
            
            
            
            nSheet.Select
                Range("B1:D1").UnMerge
                Range("E1:Q1").Cut Destination:=Range("D1:P1")
                Rows("9:9").Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("H8:J8").Cut Destination:=Range("H10:J10")
                Range("K8:L8").Cut Destination:=Range("K10:L10")
            
            Range("B7:G8").Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            Selection.Borders(xlEdgeTop).LineStyle = xlNone
            Selection.Borders(xlEdgeBottom).LineStyle = xlNone
            Selection.Borders(xlInsideVertical).LineStyle = xlNone
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
            
            Range("M8:P8").Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            Selection.Borders(xlEdgeLeft).LineStyle = xlNone
            Selection.Borders(xlEdgeBottom).LineStyle = xlNone
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
            
            Range("O3:P7").Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            Selection.Borders(xlInsideVertical).LineStyle = xlNone
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
            
            Range("B3:G10").Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            Selection.Borders(xlInsideVertical).LineStyle = xlNone
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
            
            Range("H3:N10").Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            
            Range("O8:P10").Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            Selection.Borders(xlInsideVertical).LineStyle = xlNone
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
           
                
                Range("K7:L7").UnMerge
                Range("B1:C1").Merge
                Range("G1:H1").Merge
                    
               
            Range("P8:P10").Select
                    With Selection.Validation
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                        xlBetween, Formula1:="='REL Scoring'!$A$32:$A$33"
                        .IgnoreBlank = True
                        .InCellDropdown = True
                        .InputTitle = ""
                        .ErrorTitle = ""
                        .InputMessage = ""
                        .ErrorMessage = ""
                        .ShowInput = True
                        .ShowError = True
                    End With
            Range("E3").Select
                    With Selection.Validation
                        .Delete
                        .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _
                        Operator:=xlBetween, Formula1:="0", Formula2:="999999999999"
                        .IgnoreBlank = True
                        .InCellDropdown = True
                        .ShowInput = True
                        .ShowError = True
                    End With
                
            With dsheet
                    Range("B9:G10").Copy Destination:=nSheet.Range("B9")
                    Range("H7:L9").Copy Destination:=nSheet.Range("H7")
                    Range("M9:N10").Copy Destination:=nSheet.Range("M9")
                    Range("O8:P10").Copy Destination:=nSheet.Range("O8")
            End With
                
            Cells.Replace What:="[*]", Replacement:="", LookAt:=xlPart, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            
                                                                                                         'Modifying Equipment
            'Fixing data, inserting Actual sales, modifying POC Sales formula
            Set nSheet = wbD.Sheets("By Equipment")
            Set dSheet = wbS.Sheets("By Equipment")
                nSheet.Range("E5").EntireRow.Insert
                With dSheet
                    .Range("E2:R2").Copy Destination:=nSheet.Range("E2")
                    .Range("S3:S3").Copy Destination:=nSheet.Range("S3")
                    .Range("A5:S5").Copy Destination:=nSheet.Range("A5")
                    .Range("E4:S4").Copy Destination:=nSheet.Range("E4")
                End With

            'Modifying Total costs formula
            dSheet.Range("A59:R59").Copy
            nSheet.Select
            Cells.Find(What:="total cost", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
            ActiveSheet.Paste
            
            'Adding Risk provision row above total costs
            dSheet.Range("A63:X63").Copy
            nSheet.Select
            Cells.Find(What:="total cost", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
            ActiveCell.Offset(-1, 0).Select
            ActiveSheet.Paste
            Cells.Replace What:="[*]", Replacement:="", LookAt:=xlPart, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            
                                                                                                        'Modifying Simplified RITE
            'Adding Start and end of provision, inserting provision matrix, hiding matrix
            Set nSheet = wbD.Sheets("Simplified RITE")
            Set dSheet = wbS.Sheets("Simplified RITE")
                With nSheet
                    .Select
                    .Range("E4").EntireColumn.Insert
                    .Range("C4").ColumnWidth = 34
                    .Range("E4").ColumnWidth = 14
                    .Range("F4").ColumnWidth = 14
                End With
                
                With dSheet
                    .Range("E4:F17").Copy Destination:=nSheet.Range("E4")
                    .Range("D5").Copy Destination:=nSheet.Range("D5")
                    .Range("A50:N63").Copy Destination:=nSheet.Range("A50")
                    .Range("P6:P17").Copy Destination:=nSheet.Range("P6")
                End With
                
            Rows("50:63").EntireRow.Hidden = True
            Columns("P").EntireColumn.Hidden = True
            Cells.Replace What:="[*]", Replacement:="", LookAt:=xlPart, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            
            With wbD
                .Sheets("REL Scoring").Visible = xlHidden
                .Sheets("Summary").Select
                .Sheets("PMF").Visible = xlHidden
            End With
            
            Application.CutCopyMode = False
            wbD.Close savechanges:=True
            
        End If
  
        sFile = Dir 'next file
    Loop
     
    UserForm1.Show
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
 
End Sub

You forgot the "." before your ranges.

            With dsheet
                    .Range("B9:G10").Copy Destination:=nSheet.Range("B9")
                    .Range("H7:L9").Copy Destination:=nSheet.Range("H7")
                    .Range("M9:N10").Copy Destination:=nSheet.Range("M9")
                    .Range("O8:P10").Copy Destination:=nSheet.Range("O8")
            End With

Please click the Add Reputation star below any helpful posts, and use Thread Tools (up top) to mark your thread as SOLVED once you have your answer. Thanks!-Lee

hahaha, jesus, i'm so stupid. sorry!

though 2nd part of question, how can i shorten the border formatting/the rest of the code if possible?

Ok, thanks everyone. I have shorten the code and modified it a bit - i added at the end of the code function, which saves the opened file in variable folder (saves if exist, creates otherwise cell value defined foldername). But now my loop code broken, i get invalid procedure call or argument error on sFile = Dir right before the end of the loop. I assume it's somehow connected with wrong sFolder path after it saves the file to a new folder. Anyone could help me please?

Sub Button1_Click()
   
    Dim sFolder As String
    Dim sFile As String
    
    Dim wbD As Workbook
    Dim wbS As Workbook
    
    Dim nSheet As Worksheet
    Dim dSheet As Worksheet
    
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False

    
    Set wbS = ThisWorkbook
    sFolder = wbS.Path & "\"
                                                                                                'Loop processing all files
                                                                                                 'within masterfile folder
    sFile = Dir(sFolder)
    Do While sFile <> ""
        
        ActiveSheet.DisplayPageBreaks = False
        
        If sFile <> wbS.Name Then
            Set wbD = Workbooks.Open(sFolder & sFile)
            
            wbD.Sheets("Summary").Select                                                     'Fixing headers, adding rows,
                Range("B1:D1").UnMerge                                                                       'moving cells
                Range("E1:Q1").Cut Destination:=Range("D1:P1")
                Rows("9:9").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Rows("9:9").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("H8:J8").Cut Destination:=Range("H10:J10")
                Range("K8:L8").Cut Destination:=Range("K10:L10")
            
                                                                                                         'Copying PMF list
            Set nSheet = wbD.Sheets.Add(Type:=xlWorksheet)
            nSheet.Name = "PMF"
            wbS.Sheets("PMF").Range("A:MQ").Copy Destination:=nSheet.Range("A1")
            Cells.Replace What:="[*]", Replacement:="", LookAt:=xlPart, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            
            
                                                                                                       'Modifying Summary
            Set nSheet = wbD.Sheets("Summary")
            Set dSheet = wbS.Sheets("Summary")
            
            nSheet.Select                                                                                 'Fixing borders
            Range("B8:N8").Select
                With Selection.Borders(xlEdgeBottom)
                    .LineStyle = xlNone
                End With
            
            Range("B8:G10").Select
                With Selection.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                End With
                        With Selection.Borders(xlEdgeBottom)
                            .LineStyle = xlContinuous
                            .Weight = xlMedium
                        End With
            
            Range("O8:P8").Select
                With Selection.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                End With
               
            Range("K7:L7").UnMerge                                                                    'Merging moved cells,
            Range("B1:C1").Merge                                                                  'unmerging cells to paste
            Range("G1:H1").Merge
                                   
            With dSheet                                                                          'Inserting data in summary
                    .Range("B9:G10").Copy Destination:=nSheet.Range("B9")
                    .Range("H7:L9").Copy Destination:=nSheet.Range("H7")
                    .Range("M9:N10").Copy Destination:=nSheet.Range("M9")
                    .Range("O8:P10").Copy Destination:=nSheet.Range("O8")
                    .Range("C13:P13").Copy Destination:=nSheet.Range("C13")
            End With
            
            Range("K9").Select                                                                                  'Border fix
                With Selection.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                End With
                                                                                                   'Copying REL Scoring list
            Set nSheet = wbD.Sheets.Add(Type:=xlWorksheet)
            nSheet.Name = "REL Scoring"
            wbS.Sheets("REL Scoring").Range("A:MA").Copy Destination:=nSheet.Range("A1")
            Cells.Replace What:="[*]", Replacement:="", LookAt:=xlPart, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            
            wbD.Sheets("Summary").Select                                                           'Multi BU Data validation
                Range("P8:P10").Select
                        With Selection.Validation
                            .Delete
                            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                            xlBetween, Formula1:="='REL Scoring'!$A$32:$A$33"
                            .IgnoreBlank = True
                            .InCellDropdown = True
                            .InputTitle = ""
                            .ErrorTitle = ""
                            .InputMessage = ""
                            .ErrorMessage = ""
                            .ShowInput = True
                            .ShowError = True
                        End With
                Range("E3").Select                                                                           'SAP Number fix
                        With Selection.Validation
                            .Delete
                            .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _
                            Operator:=xlBetween, Formula1:="0", Formula2:="999999999999"
                            .IgnoreBlank = True
                            .InCellDropdown = True
                            .ShowInput = True
                            .ShowError = True
                        End With
                    
            Cells.Replace What:="[*]", Replacement:="", LookAt:=xlPart, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            
                                                                                                         'Modifying Equipment
                                                            'Fixing data, inserting Actual sales, modifying POC Sales formula
            Set nSheet = wbD.Sheets("By Equipment")
            Set dSheet = wbS.Sheets("By Equipment")
                nSheet.Range("E5").EntireRow.Insert
                With dSheet
                    .Range("E2:R2").Copy Destination:=nSheet.Range("E2")
                    .Range("S3:S3").Copy Destination:=nSheet.Range("S3")
                    .Range("A5:S5").Copy Destination:=nSheet.Range("A5")
                    .Range("E4:S4").Copy Destination:=nSheet.Range("E4")
                End With

                                                                                               'Modifying Total costs formula
            dSheet.Range("A59:R59").Copy
            nSheet.Select
            Cells.Find(What:="total cost", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
            ActiveSheet.Paste
            
                                                                                 'Adding Risk provision row above total costs
            dSheet.Range("A63:X63").Copy
            nSheet.Select
            Cells.Find(What:="total cost", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
            ActiveCell.Offset(-1, 0).Select
            ActiveSheet.Paste
            Selection.EntireRow.Insert
            Cells.Replace What:="[*]", Replacement:="", LookAt:=xlPart, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            
                                                                                                   'Modifying Simplified RITE
                                                'Adding Start and end of provision, inserting provision matrix, hiding matrix
                                                
            Set nSheet = wbD.Sheets("Simplified RITE")
            Set dSheet = wbS.Sheets("Simplified RITE")
                With nSheet
                    .Select
                    .Range("E4").EntireColumn.Insert
                    .Range("E4").EntireColumn.Insert
                    .Range("C4").ColumnWidth = 34
                    .Range("E4").ColumnWidth = 14
                    .Range("F4").ColumnWidth = 14
                End With
                
                With dSheet
                    .Range("E4:F17").Copy Destination:=nSheet.Range("E4")
                    .Range("D5").Copy Destination:=nSheet.Range("D5")
                    .Range("A50:N63").Copy Destination:=nSheet.Range("A50")
                    .Range("P6:P17").Copy Destination:=nSheet.Range("P6")
                End With
                
            Rows("50:63").EntireRow.Hidden = True
            Columns("P").EntireColumn.Hidden = True
            Cells.Replace What:="[*]", Replacement:="", LookAt:=xlPart, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            
                                                                                                              'Hiding sheets
            With wbD
                .Sheets("REL Scoring").Visible = xlHidden
                .Sheets("PMF").Visible = xlHidden
                .Sheets("Summary").Select
            End With
            

            If Len(Dir(sFolder & Range("C4"), vbDirectory)) = 0 Then
                MkDir sFolder & Range("C4")
            End If
            ChDir sFolder & Range("C4")
            wbD.SaveAs Filename:=sFolder & Range("C4") & "\PMF_" & Range("E3") & "_" & Range("E1") & ".xlsm"
            
            Application.CutCopyMode = False
            
        End If
  
        sFile = Dir                                                                                             'next file
    Loop
     
    UserForm1.Show                                                                                         'Completed Dialog
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
 
End Sub

Originally Posted by xlnitwit

You can't nest one Dir function inside another like that.

So what would be the way to avoid Dir in creating new folder or in choosing next file?

Originally Posted by xlnitwit

You might use the Scripting.Filesystemobject and its FolderExists method.

            Set fso = CreateObject("Scripting.FileSystemObject")
            If Not fso.FolderExists(sFolder & Range("C4")) Then
                   fso.CreateFolder (sFolder & Range("C4"))
            End If
            wbD.SaveAs Filename:=sFolder & Range("C4") & "\PMF_" & Range("E3") & "_" & Range("E1") & ".xlsm"

Worked perfect, thanks for advice.

Ok, here I am again guys. Modifying and modifying my code. Now I'm working on Error handling part:

1) I put

On Error Resume Next

at the start of my loop
2) I plan to use:

If Err.ErrNumber <> 0 Then

to create a list of document names at the end of the macro in custom userform. Here I personally see 2 ways how to do it:
1) I collect the errors data (each time error -> retrieve document name and store it on separate sheet) and later proceed to create a MsgBox/UserForm with this data via ShiftDown
2) Other way - I'm not sure it's possible, but to create a MsgBox/UserForm and dynamically update it each time error occurs with document name and show it at the end of whole procedure.

What are your opinions on what is the best way to implement my changes? Thanks in advance!

Private Sub PerformConsolidation_Click()
        
    Dim c As Long, lr As Long, lAllCnt As Long, sFolder As String, sFile As String, wbD As Workbook, wbS As Workbook
    Dim wsS As Worksheet, v As Variant
    Dim FileFolder As String
    Dim z As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    
    FileFolder = Range("D1").value
    
    [o1] = 0
    If Dir(FileFolder & "*.*") = "" Then Exit Sub Else z = 1
    Do
    If Dir = "" Then Exit Do Else z = z + 1
    Loop Until False
    [o1] = z
    
    lAllCnt = [l1]
    Call Show_PrBar_Or_No(lAllCnt, "Initializing...")
         
    Set wbS = thisWorkbook
    Set wsS = ActiveSheet
    sFolder = wbS.Path & "\"
     
    If Right(sFolder, 1) <> "\" Then sFolder = sFolder + "\"
    
    sFile = Dir(sFolder)
    lr = 0
    Do While sFile <> ""
    
        On Error Resume Next
        ActiveSheet.DisplayPageBreaks = False
        lr = lr + 1
        If bShowBar Then Call MyProgresBar
          
        If sFile <> wbS.Name Then
        
            Set wbD = Workbooks.Open(sFolder & sFile) 'open the file; add condition to
            
            v = Application.Match(wbD.Sheets("PMF").Range("C2"), wsS.Columns(4), 0)             'Matched SAP row number
            If IsError(v) Then v = wsS.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row       'Next empty row if no match found
            
            wbD.Sheets("PMF").Range("A2:MQ2").Copy
                With wsS
                    .Range("B" & v).PasteSpecial xlPasteFormats
                    .Range("B" & v).PasteSpecial xlPasteValuesAndNumberFormats
                    .Range("A" & v).FormulaR1C1 = "=HYPERLINK(RC[1],RC[2]&""-""&RC[3])"
                End With
            Application.CutCopyMode = False
            wbD.Close savechanges:=True 'close without saving
            If Err.Number <> 0 Then
                
        End If
        
        On Error GoTo 0
        sFile = Dir 'next file
        
        
    Loop
     
 
        If bShowBar Then Unload frmStatusBar
     
    [n1] = DateTime.Now
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    
    With UserForm5
        .Label6 = "                                                " & [n1]
        .Label8 = "                                                   " & [k1]
    End With
    UserForm4.Show

    
End Sub