need help copy pasting rows across workbooks

perezpa

New Member
Joined
Jun 17, 2011
Messages
17
I am struggling with this piece of code. I´m not very experienced with VBA so any help is appreciated.

I have already opened the external file I need, now I need to activate the workbook the macro is in and paste the copied row into a new row in the listobject named "data" which is located in the sheet named "data".

This is the piece of the code that's been giving me trouble:

For row = 1 To 100
If Left(Sheets("Resumen").Cells(row, 1).Value, 2) = "MC" Or Left _(Sheets("Resumen").Cells(row, 1).Value, 2) = "LS" Then
Cells(row, 1).EntireRow.Copy
Application.CutCopyMode = False
Set WB2 = Workbooks.Open("C:\Users\peperez\Desktop…
Application.Workbooks("test").Activate
'Set WB2 = ThisWorkbook
Range("D5").ListObject.ListRow.Add (1)
Rows("5:5").Insert
End If
Next row
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Where are you copying/pasting to/from?

The code seems to copy from the current workbook and then open the other workbook.

Then you say you want to paste to the current worbook?
 
Upvote 0
Sorry, I just copied that piece of code because that is the one that was giving me trouble. I should've just posted the entire code. Here is the entire subroutine:

Code:
Sub Actualizar_informe()
Dim folderPath As String
Dim fileName As String
Dim WB As Workbook
 
 
    folderPath = "Z:\Incentivos\Electromuebles\Consolidados\Meses Anteriores\Desde 2008"
 
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
 
    fileName = Dir(folderPath & "*.xls")
    Do While fileName <> ""
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Application.EnableEvents = False
        Set WB = Workbooks.Open(folderPath & fileName)
 
 
 
        'Call a subroutine here to operate on the just-opened workbook
        'Call agarrar_data(WB)
        '==================================================================================================================
        Dim rng, datatable As Range
        Dim WB2 As Workbook
        Dim row As Integer
 
 
                For row = 1 To 100
                    If Left(Sheets("Resumen").Cells(row, 1).Value, 2) = "MC" Or Left(Sheets("Resumen").Cells(row, 1).Value, 2) = "LS" Then
                        Cells(row, 1).EntireRow.Copy
                        Application.CutCopyMode = False
                        Set WB2 = Workbooks.Open("C:\Users\peperez\Desktop\test.xlsm")
                        Application.Workbooks("test").Activate
                        'Set WB2 = ThisWorkbook
                        Range("D5").ListObject.ListRow.Add (1)
                        Rows("5:5").Insert
                    End If
                Next row
 
        '==================================================================================================================
        WB2.Save
        WB.Close True
        fileName = Dir
    Loop
 
 
 
End Sub

I'm going through the folder named "Desde 2008" and then looping through the first 100 cells of column A, finding the ones whose value beings with "MC" or "LS", and then pasting that entire row into the workbook from where the macro is running.

P.S. Sorry about not using the code tags before.

EDIT: I'm getting a runtime error saying that the object does not support the method and refers me to 8 lines of code rom the bottom, the line starting with Range("D5")
 
Last edited:
Upvote 0
Thanks for posting the code.

It's still not clear where you are copying/pasting from/to though - the same code is still there.:)

Also which workbook is the code in?

Is it 'test'?

If it is and you want to create a reference to it you can use something like this.
Code:
Set wbThis = ThisWorkbook
That can then be used whenever you need to refer to that workbook, and, perhaps an added advantage, you don't need to activate it.

I just took another look at the code and noticed you appear to be be using Workbooks.Open at least twice.

Does that meant there's a third workbook involved?
 
Upvote 0
Yes, the code is in test.xlsm

I think i fixed the workbook situation, but i'm pretty sure thats now how i paste the copied row into thisWB.

How would I do that?

(Here's the revision)

Code:
Sub Actualizar_informe()
Dim folderPath As String
Dim fileName As String
Dim WB As Workbook
Dim thisWB As Workbook
Set thisWB = ThisWorkbook
 
 
    folderPath = "Z:\Incentivos\Electromuebles\Consolidados\Meses Anteriores\Desde 2008"
 
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
 
    fileName = Dir(folderPath & "*.xls")
    Do While fileName <> ""
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Application.EnableEvents = False
        Set WB = Workbooks.Open(folderPath & fileName)
 
 
 
        'Call a subroutine here to operate on the just-opened workbook
        'Call agarrar_data(WB)
        '==================================================================================================================
        Dim rng, datatable As Range
        Dim row As Integer
 
 
                For row = 1 To 100
                    If Left(Sheets("Resumen").Cells(row, 1).Value, 2) = "MC" Or Left(Sheets("Resumen").Cells(row, 1).Value, 2) = "LS" Then
                        Cells(row, 1).EntireRow.Copy
                        Application.CutCopyMode = False
                        thisWB.Range("D5").ListObject.ListRow.Add (1)
                        Rows("5:5").Insert
                    End If
                Next row
 
        '==================================================================================================================
        WB2.Save
        WB.Close True
        fileName = Dir
    Loop
 
 
 
End Sub

EDIT: The line at the bottom that says 'WB2.Save' should actually be 'thisWB.Save'. I just fixed that.
 
Last edited:
Upvote 0
Also, I just realized that I don't need to add a row and then insert the copied row if i just use Insert Shift:=xlDown

I changed the line with the ListObject and ListRows and simply put:

Code:
thisWB.Rows("5:5").Insert Shift:=xlDown

However, this is still giving me a runtime error '438', saying that the object doesn't support this property or function.

Help?
 
Upvote 0
That's a lot clearer, still needs a little work though - you have no workbook or worksheet reference for Cells here.
Rich (BB code):
Cells(row, 1).EntireRow.Copy
I'm guessing the workbook is the one you just opened and the worksheet is 'Resumen'?
Rich (BB code):
WB.Worksheets("Resumen").Cells(row, 1).EntireRow.Copy
Of course that might be wrong but you should get the idea.

One other thing you need to change is to either move or delete Application.CutCopyMode...

I you are going to move it put it right at the end of the code.

Oh, another thing, you could create a reference to the worksheet 'Resumen' just after you've opened the workbook.

Then you can use it in the rest of the code.
Rich (BB code):
Set WB = Workbooks.Open(...)
 
Set wsRes = WB.Worksheets("Resumen")
 
... other stuff
 
If Left(wsRes.Cells(rw, 1).Value, 2) = "MC" Or Left(wsRes.Cells(rw, 1).Value, 2) = "LS" Then
 
.... more stuff
 
Application.CutCopyMode = False

End Sub
 
Upvote 0
First of all, thanks for the help. I really appreciate it.

Now the program inserting the rows, but not pasting the values (weird). Here's the revision again:
Code:
Sub Actualizar_informe()
Dim folderPath As String
Dim fileName As String
Dim WB As Workbook
Dim thisWB As Workbook
Dim wsdata As Object
Set thisWB = ThisWorkbook
Set wsdata = thisWB.Worksheets("data")
 
 
    folderPath = "Z:\Incentivos\Electromuebles\Consolidados\Meses Anteriores\Desde 2008"
 
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
 
    fileName = Dir(folderPath & "*.xls")
    Do While fileName <> ""
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Application.EnableEvents = False
        Set WB = Workbooks.Open(folderPath & fileName)
 
        '==================================================================================================================
        Dim rng, datatable As Range
        Dim row As Integer
        Dim wsRes As Object
        Set wsRes = WB.Worksheets("Resumen")
 
 
            For row = 1 To 100
                If Left(wsRes.Cells(row, 1).Value, 2) = "MC" Or Left(wsRes.Cells(row, 1).Value, 2) = "LS" Then
                    wsRes.Cells(row, 1).EntireRow.Copy
                    wsdata.Rows("5:5").Insert Shift:=xlDown
                End If
            Next row
        '==================================================================================================================
 
        thisWB.Save
        thisWB.Close False
        WB.Close True
        fileName = Dir
    Loop
 
 
 
End Sub

Also, every time the program loops into another .xls file, a message pops up asking if I want to update the data in that file. I thought this code took care of that:
Code:
Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Application.EnableEvents = False

EDIT: I inserted a PasteSpecial after inserting the row and it worked perfectly, only thing is thisWB closed after it pasted the rows from the first document. Why?
 
Last edited:
Upvote 0
You haven't specified a destination for your copy?

So the code will copy fine, but to nowhere.

As for the message on opening the workbooks, I think what you want is the UpdateLinks argument/parameter when you are opening them.

Probably just something like this:

Code:
Workbooks.Open(..., UpdateLinks:= False)

but you better check the False but - it's not something I use often.
 
Upvote 0
You haven't specified a destination for your copy?

So the code will copy fine, but to nowhere.

What do you mean?

I thought the code is pasting it into thisWB.Rows("5:5")

Here I made some subtle changes:

Code:
Sub Actualizar_informe()
Dim folderPath As String
Dim fileName As String
Dim WB As Workbook
Dim thisWB As Workbook
Dim wsdata As Object
Set thisWB = ThisWorkbook
Set wsdata = thisWB.Worksheets("data")
 
    
    folderPath = "Z:\Incentivos\Electromuebles\Consolidados\Meses Anteriores\Desde 2008"
    
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    
    fileName = Dir(folderPath & "*.xls")
    Do While fileName <> ""
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Application.EnableEvents = False
        Set WB = Workbooks.Open(folderPath & fileName, UpdateLinks:=False)
        
        '==================================================================================================================
        Dim rng, datatable As Range
        Dim row As Integer
        Dim wsRes As Object
        Set wsRes = WB.Worksheets("Resumen")
                
                           
            For row = 1 To 100
                If Left(wsRes.Cells(row, 1).Value, 2) = "MC" Or Left(wsRes.Cells(row, 1).Value, 2) = "LS" Then
                    wsRes.Cells(row, 1).EntireRow.Copy
                    wsdata.Rows("5:5").Insert Shift:=xlDown
                    wsdata.Rows("5:5").PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True
                End If
            Next row
        '==================================================================================================================
        
        thisWB.Save
        WB.Close
        fileName = Dir
    Loop
    
 

End Sub
 
Upvote 0

Forum statistics

Threads
1,224,613
Messages
6,179,903
Members
452,948
Latest member
Dupuhini

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top