Misterious Error when copying and pasting from a second workbook

[diogodd]

Hi Gurus,

I have been facing a problem that I am unable to solve by myself.

I am copying and pasting a few worksheets from a SharePoint site into a local file. Some of the worksheets are lists so I have to differentiate among them.

Nonetheless Excel will not allow me to paste in the local file. It raises:Run-time error • 1004:

Application-defined or object-defined error I have tried all sort of workarounds like using an internal array, until i decided to hardcode the values and realized it wont allow me to paste more than 300 rows.


Please Advise!

The code follows below:

Public Sub Download_Data()


'Speed up execution and avoid unnecessary flickering of display
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim wb1, wb2 As Workbook
Dim Data As Worksheet
Dim Rng As Range
Dim MasterFilePath, MasterData As String
Dim oListObject As ListObject
Dim oListrow As ListRow
Dim oListObjectname(1) As Variant

MyPath = ThisWorkbook.Worksheets("Variables").Range("B2").Value 'Allows to change file location easily from the variables worksheet

If MyPath = "" Then
MsgBox "File address for download missing. Edit Variables Worksheet with the corresponding address"
GoTo gobacktopromocalendar
Else: End If

If Workbooks.CanCheckOut(MyPath) = True Then
MsgBox ("File on Sharepoint CAN be checked out")
Workbooks.CheckOut MyPath
Set wb2 = ThisWorkbook 'Simplifies reference to this workbook
Set wb1 = Workbooks.Open(MyPath, 0) 'Opens Master file while simplifies reference

For Each rcell In wb2.Worksheets("Variables").Range("d2:d" & Worksheets.Count)
If rcell.Value = "" Then
Exit For
Else: MasterData = rcell.Value
End If

Set Rng = wb1.Worksheets(MasterData).UsedRange 'finds out all the used range to be copied locally


If wb2.Worksheets(MasterData).ListObjects.Count > 0 Then
i = 0
For Each oListObject In wb2.Worksheets(MasterData).ListObjects
i = i + 1
oListObjectname(i) = oListObject.Name
Next oListObject
Set oListRows = wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).ListRows
If wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).DataBodyRange.Rows.Count < Rng.Rows.Count Then
For i = wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).DataBodyRange.Rows.Count To (Rng.Rows.Count) Step 1
wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).ListRows.Add AlwaysInsert:=True
Next
ElseIf wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).DataBodyRange.Rows.Count > Rng.Rows.Count Then
For i = wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).DataBodyRange.Rows.Count To (Rng.Rows.Count + 1) Step -1
Set oListRows = wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).ListRows
oListRows(i).Delete
Next

End If
wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).DataBodyRange.Value = Rng.Value 'populates list with downloaded values
oListRows(1).Delete
wb2.Worksheets("Data").Cells(1, 56).Value = "" & Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss") 'column 56 should be calculated in case size of inputs varies. states when data was transfered
Else

----------------------------------------------------------------------------------------------------------------
' Problem happens here

wb2.Activate
wb2.Worksheets(MasterData).Range(Rng.Address).Value = Rng.Value 'transfers data to local worksheet
wb2.Worksheets("Data").Cells(1, 56).Value = "" & Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss") 'column 56 should be calculated in case size of inputs varies. states when data was transfered
End If
------------------------------------------------------------------------------------------------------------------ Next rcell

wb1.CheckIn (False)
'wb1.Close savechanges:=True 'closes sharepoint file

MsgBox ("Download Complete") 'alerts that download is complete

GoTo gobacktopromocalendar
Else
MsgBox ("File is taken, try again later") 'alerts that sharepoint file is checked out and thus not available
GoTo gobacktopromocalendar
End If

gobacktopromocalendar:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


End Sub

 

[mole999]

WHEN you step through with F8 and get to where it errors, when you hover over wb2, do you see the values you expect for names etc

 

[diogodd]

Hi Mole999,


thanks for helping!


It all looks perfect. I even tried to reinforce the active workbook wb2.activate to see if I could get rid of the problem.

I also tried with a 2d array transferdata and nothing seems to work.


no clue of what is causing the error

 

[mole999]

within code tags to help readability

Public Sub Download_Data()

'Speed up execution and avoid unnecessary flickering of display
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim wb1, wb2 As Workbook
    Dim Data As Worksheet
    Dim Rng As Range
    Dim MasterFilePath, MasterData As String
    Dim oListObject As ListObject
    Dim oListrow As ListRow
    Dim oListObjectname(1) As Variant

    MyPath = ThisWorkbook.Worksheets("Variables").Range("B2").Value        'Allows to change file location easily from the variables worksheet

    If MyPath = "" Then
        MsgBox "File address for download missing. Edit Variables Worksheet with the corresponding address"
        GoTo gobacktopromocalendar
    Else: End If

    If Workbooks.CanCheckOut(MyPath) = True Then
        MsgBox ("File on Sharepoint CAN be checked out")
        Workbooks.CheckOut MyPath
        Set wb2 = ThisWorkbook        'Simplifies reference to this workbook
        Set wb1 = Workbooks.Open(MyPath, 0)        'Opens Master file while simplifies reference

        For Each rcell In wb2.Worksheets("Variables").Range("d2:d" & Worksheets.Count)
            If rcell.Value = "" Then
                Exit For
            Else: MasterData = rcell.Value
            End If

            Set Rng = wb1.Worksheets(MasterData).UsedRange        'finds out all the used range to be copied locally


            If wb2.Worksheets(MasterData).ListObjects.Count > 0 Then
                i = 0
                For Each oListObject In wb2.Worksheets(MasterData).ListObjects
                    i = i + 1
                    oListObjectname(i) = oListObject.Name
                
                Next oListObject
                
                Set oListRows = wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).ListRows
                
                If wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).DataBodyRange.Rows.Count < Rng.Rows.Count Then
                    For i = wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).DataBodyRange.Rows.Count To (Rng.Rows.Count) Step 1
                        wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).ListRows.Add AlwaysInsert:=True
                    Next
                
                ElseIf wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).DataBodyRange.Rows.Count > Rng.Rows.Count Then
                    
                    For i = wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).DataBodyRange.Rows.Count To (Rng.Rows.Count + 1) Step -1
                        Set oListRows = wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).ListRows
                        oListRows(i).Delete
                    Next

                End If
                
                wb2.Worksheets(MasterData).ListObjects(oListObjectname(1)).DataBodyRange.Value = Rng.Value        'populates list with downloaded values
                oListRows(1).Delete
                wb2.Worksheets("Data").Cells(1, 56).Value = "" & Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")        'column 56 should be calculated in case size of inputs varies. states when data was transfered
            
            Else

    '----------------------------------------------------------------------------------------------------------------
    ' Problem happens here

                wb2.Activate
                wb2.Worksheets(MasterData).Range(Rng.Address).Value = Rng.Value        'transfers data to local worksheet
                wb2.Worksheets("Data").Cells(1, 56).Value = "" & Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")        'column 56 should be calculated in case size of inputs varies. states when data was transfered
            
            End If
    '------------------------------------------------------------------------------------------------------------------ 
            Next rcell

            wb1.CheckIn (False)
    'wb1.Close savechanges:=True 'closes sharepoint file

            MsgBox ("Download Complete")        'alerts that download is complete

            GoTo gobacktopromocalendar
        Else
            MsgBox ("File is taken, try again later")        'alerts that sharepoint file is checked out and thus not available
            GoTo gobacktopromocalendar
        End If

gobacktopromocalendar:
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic

    End Sub