Moz2407
06-05-2018, 07:46 AM
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
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