Linked Workbooks, Extreme Lag/Processing Time

Re: Linked Workbooks, Extreme Lag/Processing Time

I've noticed something interesting for this formula. As it stands, there is no error, but when I change the range to what I need (Copy C2 range, paste in B2), it produces the error. With the range of A, it won't paste, but won't produce the error.

Quote from dbrown14;571070

This should be better

Code

Option Explicit
 
Sub ozgrid()
    Dim ex As Excel.Application
    Dim wrkbk As Workbook
    Dim sht1, sht2, sht3 As Worksheet
    Dim filepath, wname As String
     
On Error GoTo errH:
     
    Application.ScreenUpdating = False
    filepath = "C:\Users\dbrown\Desktop\ex2.xlsx"
    Set ex = Excel.Application
    Set wrkbk = ex.Workbooks.Open(filepath)
    Set sht1 = wrkbk.Sheets(1)
    Set sht2 = wrkbk.Sheets(2)
    Set sht3 = ThisWorkbook.Sheets(2)
     
    ThisWorkbook.Sheets(1).Range("B2", _
        ThisWorkbook.Sheets(1).Range("B2").End(xlDown).End(xlToRight)).Copy
     
    If IsEmpty(sht1.Range("A1")) Then
        sht1.Range("A1").PasteSpecial xlValues
    ElseIf IsEmpty(sht1.Range("A2")) Then
        sht1.Range("A2").PasteSpecial xlValues
    Else
        sht1.Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlValues
    End If
     
    If IsEmpty(sht2.Range("A1")) Then
        sht2.Range("A1").PasteSpecial xlValues
    ElseIf IsEmpty(sht2.Range("A2")) Then
        sht2.Range("A2").PasteSpecial xlValues
    Else
        sht2.Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlValues
    End If
     
    If IsEmpty(sht3.Range("A1")) Then
        sht3.Range("A1").PasteSpecial xlValues
    ElseIf IsEmpty(sht3.Range("A2")) Then
        sht3.Range("A2").PasteSpecial xlValues
    Else
        sht3.Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlValues
    End If
     
    wrkbk.Close True
    Set ex = Nothing
    Application.ScreenUpdating = True
    Exit Sub
errH:
    MsgBox Err.Description
End Sub

Display More

Re: Linked Workbooks, Extreme Lag/Processing Time

Thank you for your help.

I adjusted the document name in the formula and applied the macro. I'm not quite sure what it did though. In sheet1 of workbook1, it deleted almost everything and nothing was pasted to sheet2 or sheet1 and sheet2 and workbook2.

Re: Linked Workbooks, Extreme Lag/Processing Time

Oh, that does make sense but it's not entirely how my string of ducuments work in sequence. Workbook1 sheet1 is linked to a document, changing every day. This macro needs to copy filtered data, starting from C2, paste it underneath existing data in sheet2 starting at the B column, then paste it into workbook2 sheet2 and sheet2, underneath existing data.

Re: Linked Workbooks, Extreme Lag/Processing Time

That made me laugh because it's driving me insane. A few pages back, we have a complete macro, courtesy to dbrown, but the range needed to be adjusted to start at C2, not C1. I guess adjusting the range is harder than I thought when it comes to VB.

Re: Linked Workbooks, Extreme Lag/Processing Time

Is there any way to make this formula take the data from sheet1 workbook1 starting at C2, filtered, and paste it to sheet2 underneath existing data, then paste to workbook2, sheet1 and sheet2, underneath existing data? Currently, this formula copies starting at C1 and it won't modify.

Option Explicit
 
Sub CopyPaste()
    Dim ex As Excel.Application
    Dim wrkbk As Workbook
    Dim sht1, sht2, sht3 As Worksheet
    Dim filepath, wname As String
     
On Error GoTo errH:
     
    Application.ScreenUpdating = False
    filepath = "C:\Document.xlsm"
    Set ex = Excel.Application
    Set wrkbk = ex.Workbooks.Open(filepath)
    Set sht1 = wrkbk.Sheets(1)
    Set sht2 = wrkbk.Sheets(2)
    Set sht3 = ThisWorkbook.Sheets(2)
     
    ThisWorkbook.Sheets(1).Range("C2").CurrentRegion.COPY
     
    If IsEmpty(sht1.Range("B1")) Then
        sht1.Range("B1").PasteSpecial xlPasteValues
    ElseIf IsEmpty(sht1.Range("B2")) Then
        sht1.Range("B2").PasteSpecial xlPasteValues
    Else
        sht1.Range("B1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
    End If
     
    If IsEmpty(sht2.Range("B1")) Then
        sht2.Range("B1").PasteSpecial xlPasteValues
    ElseIf IsEmpty(sht2.Range("B2")) Then
        sht2.Range("B2").PasteSpecial xlPasteValues
    Else
        sht2.Range("B1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
    End If
     
    If IsEmpty(sht3.Range("B1")) Then
        sht3.Range("B1").PasteSpecial xlPasteValues
    ElseIf IsEmpty(sht3.Range("B2")) Then
        sht3.Range("B2").PasteSpecial xlPasteValues
    Else
        sht3.Range("B1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
    End If
     
    wrkbk.Close True
    Set ex = Nothing
    Application.ScreenUpdating = True
    Exit Sub
errH:
    MsgBox Err.Description
End Sub