Open & Paste in Different files

[Ruca13]

Hello everyone.

I created a code that allows me to replicate the weekly information written in one file on multiple others.

I update the information the information in the master file, and then it opens the correct file for each customer, pastes, saves and goes on to the next customer. It is based on the file names, which are weekly. If the file for the current week does not exist, the code opens the previous week file, pastes the information, and Saves As with the name of the current week.

For some reason, I am only able to do this process for two customers - it creates the file for the first two, but on the last one it does not recognize that it should open the file from the previous week.

Here's the code:

Sub FPICreation()


    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False


Dim ws As Worksheet
Dim platts As Worksheet
Dim dropboxpath As Variant
Dim fpipath As Variant
Dim fpiname As Variant
Dim oldfpiname As Variant
Dim oldfpipath As Variant
Dim fpi As Workbook
Dim plattsinfo As Range
Dim airportfees As Worksheet
Dim feesrange As Range
Dim taxes As Worksheet
Dim taxesrng As Range


Set ws = ThisWorkbook.Worksheets("Settings")
Set airportfees = ThisWorkbook.Worksheets("Fees and taxes")
Set platts = ActiveSheet
Set taxes = ThisWorkbook.Worksheets("Taxes")


Set plattsinfo = platts.Range(Cells.Address)
Set feesrange = airportfees.Range(Cells.Address)
Set taxesrng = taxes.Range(Cells.Address)


ws.Cells(3, 18) = Application.UserName


dropboxpath = ws.Cells(3, 19)
fpipath = ws.Cells(3, 25)
fpiname = ws.Cells(3, 23)
oldfpiname = ws.Cells(6, 23)
oldfpipath = ws.Cells(6, 25)


For Each cell In Range(ws.Cells(3, 21), ws.Cells(ws.Cells(3, 21).End(xlDown).Row, 21))


On Error Resume Next
Set fpi = Workbooks.Open(dropboxpath & cell & fpipath & fpiname)
If fpi Is Nothing Then
Set fpi = Workbooks.Open(dropboxpath & cell & oldfpipath & oldfpiname)
Else
End If




plattsinfo.Copy


fpi.Worksheets("Platts").Activate
fpi.Worksheets("Platts").Cells(1, 1).Select
fpi.Worksheets("Platts").Cells(1, 1).PasteSpecial xlPasteValues
fpi.Worksheets("Platts").Cells(1, 1).PasteSpecial xlPasteFormats


fpi.Worksheets("Platts").Cells(1, 1).Select


feesrange.Copy


fpi.Worksheets("Fees and taxes").Activate
fpi.Worksheets("Fees and taxes").Cells(1, 1).Select
fpi.Worksheets("Fees and taxes").Cells(1, 1).PasteSpecial xlPasteValues
fpi.Worksheets("Fees and taxes").Cells(1, 1).PasteSpecial xlPasteFormats


fpi.Worksheets("Fees and taxes").Cells(1, 1).Select


taxesrng.Copy


fpi.Worksheets("Taxes").Activate
fpi.Worksheets("Taxes").Cells(1, 1).Select
fpi.Worksheets("Taxes").Cells(1, 1).PasteSpecial xlPasteValues
fpi.Worksheets("Taxes").Cells(1, 1).PasteSpecial xlPasteFormats


fpi.Worksheets("Taxes").Cells(1, 1).Select


fpi.Sheets(1).Activate


'if fpi.name is same as the one in settings, save changes. If not, save as with new name (and new folder)


If ActiveWorkbook.Name = fpiname Then
fpi.Close savechanges:=True
Else
fpi.SaveAs Filename:=dropboxpath & cell & fpipath & fpiname
fpi.Close
End If


Application.CutCopyMode = False


Next cell


Application.CutCopyMode = False


    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True


End Sub

Can someone help me understand what's missing?

Thanks,
Rui

 

[Ruca13]

I was able to solve it, it was a problem on the error handling of the workbooks.open command.

Here's the final version of that part:

On Error Resume Next
Set fpi = Workbooks.Open(dropboxpath & cell & fpipath & fpiname)
On Error GoTo here
If fpi Is Nothing Then
here:
Set fpi = Workbooks.Open(dropboxpath & cell & oldfpipath & oldfpiname)
Else
End If