Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Excel VBA: Loop through cells and copy values to another workbook

Tags:

loops

excel

vba

I already spent hours on this problem, but I didn't succeed in finding a working solution.

Here is my problem description:

I want to loop through a certain range of cells in one workbook and copy values to another workbook. Depending on the current column in the first workbook, I copy the values into a different sheet in the second workbook. When I execute my code, I always get the runtime error 439: object does not support this method or property.

My code looks more or less like this:

Sub trial()

Dim Group As Range
Dim Mat As Range
Dim CurCell_1 As Range
Dim CurCell_2 As Range

Application.ScreenUpdating = False

Set CurCell_1 = Range("B3") 'starting point in wb 1

For Each Group in Workbooks("My_WB_1").Worksheets("My_Sheet").Range("B4:P4")
    Set CurCell_2 = Range("B4") 'starting point in wb 2
    For Each Mat in Workbooks("My_WB_1").Worksheets("My_Sheet").Range("A5:A29")
        Set CurCell_1 = Cells(Mat.Row, Group.Column) 'Set current cell in the loop
        If Not IsEmpty(CurCell_1)
            Workbooks("My_WB_2").Worksheets(CStr(Group.Value)).CurCell_2.Value = Workbooks("My_WB_1").Worksheets("My_Sheet").CurCell_1.Value 'Here it break with runtime error '438 object does not support this method or property
            CurCell_2 = CurCell_2.Offset(1,0) 'Move one cell down
        End If
    Next
Next

Application.ScreenUpdating = True

End Sub

I've done extensive research and I know how to copy values from one workbook to another if you're using explicit names for your objects (sheets & ranges), but I don't know why it does not work like I implemented it using variables. I also searched on stackoverlow and -obviously- Google, but I didn't find a similar problem which would answer my question.

So my question is: Could you tell me where the error in my code is or if there is another easier way to accomplish the same using a different way?

This is my first question here, so I hope everything is fine with the format of my code, the question asked and the information provided. Otherwise let me know.

like image 256
Patrick Avatar asked Dec 13 '22 01:12

Patrick


1 Answers

5 Things...

1) You don't need this line

Set CurCell_1 = Range("B3") 'starting point in wb 1

This line is pointless as you are setting it inside the loop

2) You are setting this in a loop every time

Set CurCell_2 = Range("B4")

Why would you be doing that? It will simply overwrite the values every time. Also which sheet is this range in??? (See Point 5)

3)CurCell_2 is a Range and as JohnB pointed it out, it is not a method.

Change

Workbooks("My_WB_2").Worksheets(CStr(Group.Value)).CurCell_2.Value = Workbooks("My_WB_1").Worksheets("My_Sheet").CurCell_1.Value

to

CurCell_2.Value = CurCell_1.Value

4) You cannot assign range by just setting an "=" sign

CurCell_2 = CurCell_2.Offset(1,0)

Change it to

Set CurCell_2 = CurCell_2.Offset(1,0)

5) Always specify full declarations when working with two or more objects so that there is less confusion. Your code can also be written as

Option Explicit

Sub trial()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim Group As Range, Mat As Range
    Dim CurCell_1 As Range, CurCell_2 As Range

    Application.ScreenUpdating = False
    
    '~~> Change as applicable
    Set wb1 = Workbooks("My_WB_1")
    Set wb2 = Workbooks("My_WB_2")
    
    Set ws1 = wb1.Sheets("My_Sheet")
    Set ws2 = wb2.Sheets("Sheet2") '<~~ Change as required

    For Each Group In ws1.Range("B4:P4")
        '~~> Why this?
        Set CurCell_2 = ws2.Range("B4")
        For Each Mat In ws1.Range("A5:A29")
            Set CurCell_1 = ws1.Cells(Mat.Row, Group.Column)
            If Not IsEmpty(CurCell_1) Then
                CurCell_2.Value = CurCell_1.Value
                Set CurCell_2 = CurCell_2.Offset(1)
            End If
        Next
    Next

    Application.ScreenUpdating = True
End Sub
like image 157
Siddharth Rout Avatar answered Apr 26 '23 20:04

Siddharth Rout