Move Multiple files in 1 Macro VBA

[thardin]

Here is the code I currently have to attempt moving multiple files in 1 macro. At the end, the Name function works, but only for 1 (the top one). When I run the macro, the 1st file moves, but then I get a yellow error on the 2nd one. And when I reorder the files, the same thing happens.

Is it possible to move all these in 1 macro, or do I have to split it?

Also, how would you recommend using an IF and THEN statement to move the 2 Monday files requested (view comments on the top).
Any other recommendations would be appreciated.

Thank you.




Sub MoveFiles()
'
' MoveFile Macro


'-------------------------------------
'Daily:
'-Move today's B&E, Del To Fund, Bene Default, and Firm C Share files
'-Move yesterday's Aggin file
'On Mondays:
'Move "Del to Fund" File with Saturday's date instead of current date
'Move Aggin File with Friday's date
'--------------------------------------

'
Dim strYearLong As String
Dim strMonthShort As String
Dim strMonthLong As String
Dim strDay As String
Dim strFullDate As String
Dim strmonthFolder As String
Dim strDrive As String
Dim Acut As String, Bcut As String, Dcut As String, Ecut As String, Fcut As String
Dim APaste As String, BPaste As String, DPaste As String, EPaste As String, FPaste As String
Dim APath As String, BPath As String, DPath As String, EPath As String, FPath As String
Dim AgginFileTitle As String, BE_FileTitle As String, Del_to_Fund_FileTitle As String, Bene_Default_FileTitle As String, Firm_Name_FileTitle As String, FileExtension As String
Dim TodayDate As String, AgginDate As String
Dim CutfromPath As String, PastetoPath As String
Dim AgginCutfromPath As String



strYearLong = Format(Now, "yyyy")
strMonthShort = Format(Now, "mm")
strMonthLong = Format(Now, "mmmm")
strDay = Format(d, "DD")
TodayDate = Format(Date, "YYYYMMDD")
AgginDate = Format(Date - 1, "YYYYMMDD")
strmonthFolder = strMonthShort & "-" & strMonthLong

'current location of file
strDrive = "X:"
CutfromPath = strDrive & "\operations\euc\Dept_Reports\MF\529_Exceptions\"
AgginCutfromPath = strDrive & "\surpas_files_tempe\EPM\output\"

'location to paste to
PastetoPath = strDrive & "\shareholder_accounting\"



'Final File destination based on file & current date
APath = PastetoPath & "529 BASIS + EARNINGS\REPORTS\CROSSOVER\EPM\" & strYearLong & "\"
BPath = PastetoPath & "MF Trade Review\American 529 Daily Reports\Basis & Earnings Rollovers\" & strYearLong & "\" & strmonthFolder & "\"
DPath = PastetoPath & "529 C Share Restriction Controls\Fund Held\Delivered to Fund\EPM_output\" & strYearLong & "\" & strmonthFolder & "\"
EPath = PastetoPath & "529 Bene Default\" & strYearLong & "\" & strmonthFolder & "\"
FPath = PastetoPath & "529 C Share Restriction Controls\Firm Name\Daily EPM Reports\" & strYearLong & "\" & strmonthFolder & "\"

'File Name part 1
AgginFileTitle = "AGGIN-Crossover__Accounts_DAILY-"
BE_FileTitle = "OBSB158_B_&_E_Rollover_Query-10_digit_"
Del_to_Fund_FileTitle = "OBSB158_Delivered_to_Fund_"
Bene_Default_FileTitle = "OBSB158_Bene_Default_"
Firm_Name_FileTitle = "OBSB158_529_C_Shares_Age_LE_12_Transactions-_"
FileExtension = ".xlsx"

'File Names & Current Date & Extension
AgginFile_Name = AgginFileTitle & AgginDate & FileExtension
BE_File_Name = BE_FileTitle & TodayDate & FileExtension
Del_to_Fund_File_Name = Del_to_Fund_FileTitle & TodayDate & FileExtension
Bene_Default_File_Name = Bene_Default_FileTitle & TodayDate & FileExtension
Firm_Name_File_Name = Firm_Name_FileTitle & TodayDate & FileExtension

'Variables for successful Cut
Acut = AgginCutfromPath & AgginFile_Name
Bcut = CutfromPath & BE_File_Name
Dcut = CutfromPath & Del_to_Fund_File_Name
Ecut = CutfromPath & Bene_Default_File_Name
Fcut = CutfromPath & Firm_Name_File_Name

'Variables for successful move
APaste = APath & AgginFile_Name
BPaste = BPath & BE_File_Name
DPaste = DPath & Del_to_Fund_File_Name
EPaste = EPath & Bene_Default_File_Name
FPaste = FPath & Firm_Name_File_Name


'Example of a successfull file move
'Name "C:\Users\P213996\OneDrive - Edward Jones\Desktop\529ACANCEL101121.csv" As _
"C:\Users\P213996\OneDrive - Edward Jones\Desktop\MoveFolder\529ACANCEL101121.csv"


'Firm Name C Share Move
Name Fcut As FPaste

'Bene Default move
Name Ecut As EPaste

'B&E Move
Name Bcut As BPaste

'Del to Fund Move
Name Dcut As DPaste


'Aggin Move
Name Acut As APaste


End Sub

 

[Sufiyan97]

This will merge all different workbooks in folder to one workbook in separate tabs:

Sub MergeExcelFiles()
    Dim fnameList, fnameCurFile As Variant
    Dim countFiles, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook, wbkSrcBook As Workbook
    
    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
    
    If (vbBoolean <> VarType(fnameList)) Then
    
        If (UBound(fnameList) > 0) Then
            countFiles = 0
            countSheets = 0
            
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual

            Set wbkCurBook = ActiveWorkbook
            
            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1
                
                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
                
                For Each wksCurSheet In wbkSrcBook.Sheets
                    countSheets = countSheets + 1
                    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                Next
                
                wbkSrcBook.Close SaveChanges:=False
                
            Next
            
            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic

            MsgBox "Procesed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If
        
    Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
End Sub

and then this will merge all the sheet tabs in to one, you need to create new tab and name it "Master"

Sub Copy_Sheets_To_Master()

Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim ans As Long

For i = 1 To Sheets.Count
With Sheets(i)
    ans = .Cells(Rows.Count, "A").End(xlUp).Row
    Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
        .Cells(3, 1).Resize(ans, 100).Copy Sheets("Master").Cells(Lastrow, 1)
End With
Next
Application.ScreenUpdating = True
End Sub

 

[thardin]

This will merge all different workbooks in folder to one workbook in separate tabs:

Sub MergeExcelFiles()
    Dim fnameList, fnameCurFile As Variant
    Dim countFiles, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook, wbkSrcBook As Workbook
   
    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
   
    If (vbBoolean <> VarType(fnameList)) Then
   
        If (UBound(fnameList) > 0) Then
            countFiles = 0
            countSheets = 0
           
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual

            Set wbkCurBook = ActiveWorkbook
           
            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1
               
                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
               
                For Each wksCurSheet In wbkSrcBook.Sheets
                    countSheets = countSheets + 1
                    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                Next
               
                wbkSrcBook.Close SaveChanges:=False
               
            Next
           
            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic

            MsgBox "Procesed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If
       
    Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
End Sub

and then this will merge all the sheet tabs in to one, you need to create new tab and name it "Master"

Sub Copy_Sheets_To_Master()

Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim ans As Long

For i = 1 To Sheets.Count
With Sheets(i)
    ans = .Cells(Rows.Count, "A").End(xlUp).Row
    Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
        .Cells(3, 1).Resize(ans, 100).Copy Sheets("Master").Cells(Lastrow, 1)
End With
Next
Application.ScreenUpdating = True
End Sub

Sorry, but that's not what I'm trying to accomplish.
I'm trying to move 5 files from 1 folder to all separate folder locations in 1 macro. (Please look at my code I provided).

Do you know how to accomplish this task?
Thanks.

 

[Sufiyan97]

Do you know how to accomplish this task?

Sorry I do not, I thought you want to combine multiple sheets into one.