PDA

View Full Version : [SOLVED] VBA - Moving files



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

Paul_Hossler
06-05-2018, 08:30 AM
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
06-06-2018, 12:30 AM
Thank you Paul - very much appreciated. I now know exactly where I went wrong.