Copy and Pasting data from Master workbook to other workbooks suddenly pasting data back into master file

Question

I currently have a process that runs through 19 files that are used and updated on a daily basis. This is the only portion that isnt currently working as it has been up until a few days ago. Today I have run the process as usual and when getting to the "Central Pacific" & "Copper Canyon" files it is dumping the data back into the master file which in turn is corrputing the data for the other files, hopefully this is something that can easily be fixed! TIA

Sub Split()

Dim BB As Workbook
Dim CP As Workbook
Dim CC As Workbook
Dim GE As Workbook
Dim GN As Workbook
Dim MA As Workbook
Dim MO As Workbook
Dim NP As Workbook
Dim OE As Workbook
Dim PE As Workbook
Dim QT As Workbook
Dim SF As Workbook
Dim SH As Workbook
Dim SP As Workbook
Dim TG As Workbook
Dim TT As Workbook
Dim TS As Workbook
Dim TC As Workbook
Dim WH As Workbook
Dim LR As Long
Dim LR1 As Long
Dim LR2 As Long
Dim LR3 As Long
Dim LR4 As Long
Dim LR5 As Long
Dim LR6 As Long
Dim LR7 As Long
Dim LR8 As Long
Dim LR9 As Long
Dim LR10 As Long
Dim LR11 As Long
Dim LR12 As Long
Dim LR13 As Long
Dim LR14 As Long
Dim LR15 As Long
Dim LR16 As Long
Dim LR17 As Long
Dim LR18 As Long
Dim LR19 As Long
Dim LR20 As Long
Dim LR21 As Long
Dim NT As Worksheet
Dim WB As Workbook

Set WB = ThisWorkbook
Set NT = ThisWorkbook.Sheets("New Transactions")

'Set workbook names
Set BB = Workbooks("Buffalo Bayou.xlsb")
Set CP = Workbooks("Central Pacific.xlsb")
Set CC = Workbooks("Copper Canyon.xlsb")
Set GE = Workbooks("Glacier Express.xlsb")
Set GN = Workbooks("Great Northern.xlsb")
Set MA = Workbooks("Maharajas Express.xlsb")
Set MO = Workbooks("Mobile & Ohio.xlsb")
Set NP = Workbooks("Northern Pacific.xlsb")
Set OE = Workbooks("Orient Express.xlsb")
Set PE = Workbooks("Pennsylvania.xlsb")
Set QT = Workbooks("Qinghai Tibet.xlsb")
Set SF = Workbooks("Santa Fe.xlsb")
Set SH = Workbooks("Shinkansen.xlsb")
Set SP = Workbooks("Southern Pacific.xlsb")
Set TG = Workbooks("The Ghan.xlsb")
Set TT = Workbooks("The Tazara.xlsb")
Set TS = Workbooks("Trans Siberian.xlsb")
Set TC = Workbooks("Tren Crucero.xlsb")
Set WH = Workbooks("West Highland.xlsb")

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.ErrorCheckingOptions.BackgroundChecking = False


'Paste to Buffalo Bayou
NT.Activate
LR = Range("A:A").SpecialCells(xlCellTypeLastCell).Row
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Buffalo Bayou"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
BB.Sheets("Worksheet").Activate
LR1 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR1).Offset(1, 0).PasteSpecial xlPasteValues


End If
End With

'Paste to Central Pacific
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Central Pacific"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
CP.Sheets("Worksheet").Activate
LR2 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR2).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to Copper Canyon
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Copper Canyon"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
CC.Sheets("Worksheet").Activate
LR3 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR3).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to Glacier Express
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Glacier Express"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
GE.Sheets("Worksheet").Activate
LR4 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR4).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to Great Northern
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Great Northern"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
GN.Sheets("Worksheet").Activate
LR5 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR5).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to Maharaja Express
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Maharajas Express"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
MA.Sheets("Worksheet").Activate
LR6 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR6).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to Mobile & Ohio
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Mobile & Ohio"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
MO.Sheets("Worksheet").Activate
LR7 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR7).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to Northern Pacific
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Northern Pacific"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
NP.Sheets("Worksheet").Activate
LR8 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR8).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to Orient Express
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Orient Express"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
OE.Sheets("Worksheet").Activate
LR9 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR9).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to Pennsylvania
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Pennsylvania"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
PE.Sheets("Worksheet").Activate
LR10 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR10).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to Qinghai-Tibet
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Qinghai Tibet"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
QT.Sheets("Worksheet").Activate
LR11 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR11).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to Santa Fe
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Santa Fe"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
SF.Sheets("Worksheet").Activate
LR12 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR12).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to Shinkansen
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Shinkansen"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
SH.Sheets("Worksheet").Activate
LR13 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR13).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to Southern Pacific
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Southern Pacific"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
SP.Sheets("Worksheet").Activate
LR14 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR14).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to The Ghan
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="The Ghan"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
TG.Sheets("Worksheet").Activate
LR15 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR15).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to The Tazara
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="The Tazara"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
TT.Sheets("Worksheet").Activate
LR16 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR16).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to The Trans-Siberian
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Trans Siberian"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
TS.Sheets("Worksheet").Activate
LR17 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR17).Offset(1, 0).PasteSpecial xlPasteValues

End If
End With

'Paste to The Tren Crucero
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="Tren Crucero"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
TC.Sheets("Worksheet").Activate
LR18 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR18).Offset(1, 0).PasteSpecial xlPasteValues
NT.Activate
.AutoFilter Field:=26
.AutoFilter Field:=24
End If
End With

'Paste to West Highland
NT.Activate
AutoFilter = True
With NT.Range("A1:Z1")
Range("A1").AutoFilter Field:=26, Criteria1:="West Highland"
Range("A1").AutoFilter Field:=24, Criteria1:="#N/A"
If NT.Range("J2:J" & LR).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
NT.Range("A2:W" & LR).SpecialCells(xlCellTypeVisible).Copy
WH.Sheets("Worksheet").Activate
LR19 = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
Range("A" & LR19).Offset(1, 0).PasteSpecial xlPasteValues
NT.Activate
.AutoFilter Field:=26
.AutoFilter Field:=24
End If
End With

NT.Activate
AutoFilter = False

MsgBox "Split Part 1 Complete"

End Sub

You need to learn how to qualify Range etc so that you are no always referring to the activesheet (which may change unexpectedly). When we say qualify, we mean you need to specify the workbook and worksheet '..Range> — freeflow, Oct 03 '22 at 13:46
It is not easy to read your code, but most probably using `Activate` is a bad habit and it does not bring any benefit, only consumes Excel resources and creates situations like that... You should avoid it and fully qualify the used ranges. — FaneDuru, Oct 03 '22 at 13:47
It also wouldn't do you any harm to read up an arrays and scripting.dictionaries so that you can move away from numbered variables. — freeflow, Oct 03 '22 at 13:47
As @freeflow said. Just from reading the question title - [activate / select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) <- have a read of the link. — Darren Bartrup-Cook, Oct 03 '22 at 14:12
Just noticed..... you're using `With...End With` code blocks, but the references inside the block aren't using it. E.g. `With Sheet1.Range("B2:Z5") : Msgbox .Cells(1,1).Address : Msgbox Cells(1,1).Address : End With` The first `Cells` reference starts with a `.` so the reference is relevant to `Range("B2:Z5")` and will return B2 (the first cell in that range). The second cells reference hasn't got the `.` so refers to the activesheet as a whole and returns cell A1 (the first cell in the sheet range). — Darren Bartrup-Cook, Oct 03 '22 at 14:21
Thanks all for your comments, I have removed all of the Activate references so far however it is still skipping the same 2 files and @DarrenBartrup-Cook I will have a read of that link you posted — rmba22875, Oct 03 '22 at 14:34

Tim Williams · Answer 1 · 2022-10-03T20:27:20.353

Your code has a lot of repetition which cries out for a loop. Try somethingl ike this (untested)

Sub Split()

    Dim LR As Long
    Dim NT As Worksheet
    Dim WB As Workbook, v, rngData As Range, rngFilter As Range
    
    Set WB = ThisWorkbook
    Set NT = ThisWorkbook.Sheets("New Transactions")

    Set rngFilter = NT.Range("A1:W" & NT.Cells(Rows.Count, "A").End(xlUp).Row)
    Set rngData = rngFilter.Offset(1).Resize(rngFilter.Rows.Count - 1) 'without header row
    
    OptimizePerformance
    
    'add other filter values to the array below....
    For Each v In Array("Buffalo Bayou", "Central Pacific", "Copper Canyon")
        
        If NT.AutoFilterMode Then NT.AutoFilter.ShowAllData
        rngFilter.AutoFilter Field:=26, Criteria1:=v
        rngFilter.AutoFilter Field:=24, Criteria1:="#N/A"
        
        If rngFilter.Columns("J").SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
            rngData.SpecialCells(xlCellTypeVisible).Copy
            Workbooks(v & ".xlsb").Worksheets("Worksheet"). _
                    Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
        End If
        
    Next v
    
    OptimizePerformance False
        
End Sub


Sub OptimizePerformance(Optional TurnOnOptimizations As Boolean = True)
    Application.Calculation = IIf(TurnOnOptimizations, _
                             xlCalculationManual, xlCalculationAutomatic)
    Application.ScreenUpdating = Not TurnOnOptimizations
    Application.EnableEvents = Not TurnOnOptimizations
    Application.ErrorCheckingOptions.BackgroundChecking = Not TurnOnOptimizations
End Sub

Thanks! Will give this a try tomorrow. I couldn’t get it to loop through originally when building it out — rmba22875, Oct 03 '22 at 18:44

Copy and Pasting data from Master workbook to other workbooks suddenly pasting data back into master file

1 Answers1