Updating The Same Worksheet in Workbook A, from 7 Worksheets in Workbook B

[reberryjr]

I'm trying to update 1 workbook with contents from 7 sheets on another workbook. I have the code below, which works for the first portion of the code, but when it cycles down to the CRT portion, I get an "Application-Defined or Object-Defined" error. I'm not sure why, as the syntax is the same as the code that works. The error first occurs on the line in red font. I hit F8 to see what happens, then the updates are made (to the wrong row), but then the error appears again on the line in blue font.

Now, I could build 7 procedures, 1 for each sheet, but I don't think that's the optimal solution.

What am I missing?

Sub CopyEmails_AM()
Application.ScreenUpdating = False
Dim m, s As Workbook
Dim mws, sws1, sws2, sws3, sws4, sws5, sws6, sws7 As Worksheet
Dim i, mLR As Long
Set m = ThisWorkbook
Set mws = ThisWorkbook.Sheets("AM_Consolidated")
mLR = mws.Range("A" & Rows.Count).End(xlUp).Row
mQLR = mws.Range("D" & Rows.Count).End(xlUp).Row
Set s = Workbooks.Open("FilePath")
Set sws1 = s.Worksheets("FL_LOP")
Set sws2 = s.Worksheets("C_Claims")
Set sws3 = s.Worksheets("TILA")
Set sws4 = s.Worksheets("US_Card_Lit")
Set sws5 = s.Worksheets("CAT")
Set sws6 = s.Worksheets("CRT")
Set sws7 = s.Worksheets("ELT")
sws1LR = sws1.Range("A" & Rows.Count).End(xlUp).Row
sws2LR = sws2.Range("A" & Rows.Count).End(xlUp).Row
sws3LR = sws3.Range("D" & Rows.Count).End(xlUp).Row
sws4LR = sws4.Range("D" & Rows.Count).End(xlUp).Row
sws5LR = sws5.Range("D" & Rows.Count).End(xlUp).Row
sws6LR = sws6.Range("D" & Rows.Count).End(xlUp).Row
sws7LR = sws7.Range("D" & Rows.Count).End(xlUp).Row
If sws1.Range("A2").Value = "" Then GoTo C_Claims
    With sws1.Range("F2:F" & sws1LR)
        .TextToColumns Destination:=sws1.Range("F2"), _
        DataType:=xlDelimited, _
        Space:=True, _
        FieldInfo:=Array(Array(1, 9), Array(2, 3), Array(3, 9), Array(4, 9))
    End With
    
    sws1.Range(Cells(2, 1), Cells(sws1LR, 1)).Copy
        mws.Range("B" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    sws1.Range(Cells(2, 2), Cells(sws1LR, 2)).Copy
        mws.Range("C" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    sws1.Range(Cells(2, 6), Cells(sws1LR, 6)).Copy
        mws.Range("D" & mLR + 1).PasteSpecial Paste:=xlPasteValues
        
With mws.Range("F" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 4))
    .Value = "FL_LOP"
End With
With mws.Range("A" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, -1))
    .Value = "FL_LOP"
End With
With mws.Range("H" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 6))
    .Value = Format(Now, "MM/DD/YY")
End With
With mws.Range("I" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 7))
    .Value = "Y"
End With
GoTo C_Claims
C_Claims:
If sws2.Range("A2").Value = "" Then GoTo TILA
TILA:
If sws3.Range("D2").Value = "" Then GoTo US_Card_Lit
US_Card_Lit:
If sws4.Range("D2").Value = "" Then GoTo CAT
CAT:
If sws5.Range("D2").Value = "" Then GoTo CRT
CRT:
sws6.Range("E1").Value = "Empty"
If sws6.Range("D2").Value = "" Then GoTo ELT
    'Who to Bucket 1
    [COLOR=#ff0000]sws6.Range(Cells(2, 4), Cells(sws6LR, 4)).Copy[/COLOR]
        mws.Range("B" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    'Subject to Bucket 2
    [COLOR=#0000cd]sws6.Range(Cells(2, 8), Cells(sws6LR, 8)).Copy[/COLOR]
        mws.Range("C" & mLR + 1).PasteSpecial Paste:=xlPasteValues
    'Assigned On to Date
    sws6.Range(Cells(2, 5), Cells(sws6LR, 5)).Copy
        mws.Range("D" & mLR + 1).PasteSpecial Paste:=xlPasteValues
        
    'Calculates SLA - Adds 2 workdays to received date.
    With mws.Range("E" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 3))
        .Value = "=WORKDAY(RC[-1],2)"
    End With
    
    With mws.Range("F" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 4))
        .Value = "CRT"
    End With
    With mws.Range("A" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, -1))
        .Value = "CRT"
    End With
    
    With mws.Range("H" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 6))
        .Value = Format(Now, "MM/DD/YY")
    End With
    
    With mws.Range("I" & mQLR + 1, mws.Range("B" & Rows.Count).End(xlUp).Offset(, 7))
        .Value = "Y"
    End With
ELT:
'If sws7.Range("D2").Value = "" Then
'    s.Close SaveChanges = False
'    Exit Sub
'End If
 
 

Application.ScreenUpdating = True
End Sub

 

[Fluff]

If the sws6 sheet is not the active sheet you need to fully qualify the ranges like

sws6.Range(sws6.Cells(2, 4), sws6.Cells(sws6LR, 4)).Copy

 

[reberryjr]

Ahhhh....so the easier route is just to activate the worksheet. Thanks for the info!

Another question on the same code. My infamous inability to work with Last Rows. How can I readjust the Last Row as the different sections of code finish? It's not as if it's LR + 1. Example: If the first tab that's interrogated brings over 2 records, the LR is now 3, but the code is treating it as row 1.

 

[Fluff]

Just recalculate the new last row, each time you paste data in.