Hello,
I have macro written where basically the aim is to loop through two directories and edit worksheets. To clarify, I have two folders that I must loop though: "August" and "Test." Both folders have the same number of files in them and they are listed in order. I need the first files in each respective folder to open simultaneously, populate the "Test" file and save that file in a different folder while closing the "August" file. The problem I'm having is that my loop isn't working. Sometimes there is an error, and other times the same file opens over and over again after the loop, never moving to the next file in the directory. Can anyone help?
I have macro written where basically the aim is to loop through two directories and edit worksheets. To clarify, I have two folders that I must loop though: "August" and "Test." Both folders have the same number of files in them and they are listed in order. I need the first files in each respective folder to open simultaneously, populate the "Test" file and save that file in a different folder while closing the "August" file. The problem I'm having is that my loop isn't working. Sometimes there is an error, and other times the same file opens over and over again after the loop, never moving to the next file in the directory. Can anyone help?
Code:
Sub Work()
Dim sourcePath As String
Dim sourcePath1 As String
Dim curFile As String
Dim curFile1 As String
Dim curWB As Excel.Workbook
Dim curWB1 As Excel.Workbook
Dim destWB As Excel.Workbook
Dim FileName As String
Dim FilePath As String
Dim oFileScript As Object
Application.ScreenUpdating = False
Set destWB = ActiveWorkbook
sourcePath = "C:\Documents and Settings\TZedalis\Desktop\August"
sourcePath1 = "C:\Documents and Settings\TZedalis\Desktop\Test"
FilePath = "C:\Documents and Settings\TZedalis\Desktop\Test1"
curFile1 = Dir(sourcePath1 & "\*.xls")
curFile = Dir(sourcePath & "\*.xls")
Do While curFile <> "" And curFile1 <> ""
Set curWB1 = Workbooks.Open(sourcePath1 & "\" & curFile1)
Set curWB = Workbooks.Open(sourcePath & "\" & curFile)
FileName = Range("B5")
Windows(curFile).Activate
Range("E22").Select
Selection.Copy
Windows(curFile1).Activate
Range("D10").Select
ActiveSheet.Paste
curWB.Close
curFile = Dir()
Set oFileScript = CreateObject("Scripting.FileSystemObject")
If oFileScript.fileexists(FilePath & FileName) Then
MsgBox "A file by the name " & FileName & " already exists in " & FilePath _
& vbCrLf & "Choose another name"
Application.Dialogs(xlDialogSaveAs).Show (FileName)
Else
ChDir "C:\Documents and Settings\TZedalis\Desktop\Test1"
ActiveWorkbook.SaveAs FileName:= _
"C:\Documents and Settings\TZedalis\Desktop\Test1\" & FileName, FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
End If
ActiveWorkbook.Close
Set oFileScript = Nothing
Loop
End Sub