VBA - Moving files

[Moz2407]

Hi All,

Long time lurker first time poster looking for some help.

I have some code below which runs through files in a folder, selects key items of data and copies it into another sheet. It does this for all files in that folder before stopping. What I have tried to do unsuccessfully is figure out how to move each completed file to a "completed" folder when done; thus allowing me to run the script whenever I want and not duplicate anything.
I have looked around and believe I need to use something similar to oldfilename AS newfilename but try as I might I cannot get the syntax or perhaps it's place in the code correct. Any help given would be greatly appreciated. I should point out that if the script errors I do not want the offending errored file being moved.

Sub ABC()
Dim sPath As String, sName As String
Dim bk As Workbook, r As Range
Dim r1 As Range
Dim R3 As Range, sh2 As Worksheet
Dim Worksheet

Application.AskToUpdateLinks = False
 Set sh = Sheets("TypeA")
Set sh2 = ActiveSheet
sPath = "C:\Users\morris.coyle.ext\Documents\Surveys\"
sName = Dir(sPath & "*.xls?")
Do While sName <> ""
On Error Resume Next
 Set bk = Workbooks.Open(sPath & sName, UpdateLinks:=0)
 Set r = bk.Worksheets("Summary Page").Range("D4")
 Set r2 = bk.Worksheets("new server survey").Range("E35:E37")
  Set r1 = sh.Cells(sh.Rows.Count, 1).End(xlUp)(2)
  Set R3 = sh.Cells(sh.Rows.Count, 2).End(xlUp)(2)
 r.Copy
 r1.PasteSpecial xlValues
 r1.PasteSpecial xlFormats
 r2.Copy
 R3.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
            
 bk.Close SaveChanges:=False
 sName = Dir()
   
Loop

End Sub

[Paul_Hossler]

not tested, but I added 4-5 lines as a start

Option Explicit
Sub ABC()
    Dim sPath As String, sName As String
    Dim bk As Workbook, r As Range, r2 As Range
    Dim r1 As Range
    Dim r3 As Range, sh2 As Worksheet, sh As Worksheet
    
    'phh
    Dim sBKname As String, sCompleted As String
    
    Application.AskToUpdateLinks = False
    
    Set sh = Sheets("TypeA")
    Set sh2 = ActiveSheet
    
    sPath = "C:\Users\morris.coyle.ext\Documents\Surveys\"
    'phh
    sCompleted = sPath & "Completed\"
    sName = Dir(sPath & "*.xls?")
    
    Do While sName <> ""
    
'    On Error Resume Next
        Set bk = Workbooks.Open(sPath & sName, UpdateLinks:=0)
        
        'phh
        sBKname = bk.FullName
        
        Set r = bk.Worksheets("Summary Page").Range("D4")
        Set r2 = bk.Worksheets("new server survey").Range("E35:E37")
        Set r1 = sh.Cells(sh.Rows.Count, 1).End(xlUp)(2)
        Set r3 = sh.Cells(sh.Rows.Count, 2).End(xlUp)(2)
        
        r.Copy
        r1.PasteSpecial xlValues
        r1.PasteSpecial xlFormats
        r2.Copy
        r3.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            
        bk.Close SaveChanges:=False
        
        'phh
        Name sBKname As sCompleted & sName
        
        sName = Dir()
    
    Loop
End Sub

[Moz2407]

Thank you Paul - very much appreciated. I now know exactly where I went wrong.