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

Question

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 t

Answer 1

Workbooks("My_WB_2").Worksheets(CStr(Group.Value)).CurCell_2.Value

This will not work, since CurCell_2 is not a method of Worksheet, but a variable. Replace by

Workbooks("My_WB_2").Worksheets(CStr(Group.Value)).Range("B4").Value

Answer 2

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 (UNTESTED)

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