insert the line values below on table of the sheet 1 from sheet 2

[Birnen]

Hello
It will be possible for someone to give me some help with the Macro Fill table.
The result I want is outlined in sheet 2.

thanks

[dflak]

I think this does what you want.

[Marc L]

As a starter :

Sub Demo1()
              Dim V(), W, R&, C%, F%, L&
    With Arkusz2.[B1].CurrentRegion.Rows
        With .Item("4:" & .Count)
            ReDim V(1 To Application.CountA(.Columns("A:C")), 1 To 5)
            W = .Value
        End With
    End With
    For R = 1 To UBound(W)
        For C = 1 To 3
            If W(R, C) > "" Then
                      F = C * 4
                      L = L + 1
                V(L, 1) = W(R, C)
                V(L, 2) = W(R, F)
                V(L, 3) = W(R, F + 1)
                V(L, 4) = W(R, F + 2)
                V(L, 5) = W(R, F + 3)
            End If
        Next
    Next
    With Arkusz1
        .UsedRange.Offset(3).ClearContents
        .[B4:F4].Resize(L).Value = V
    End With
End Sub 

Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !

[Marc L]

Sub Demo2()
     Dim L&, R&, C%, F%
         L = 3
         Application.ScreenUpdating = False
         Arkusz1.UsedRange.Offset(3).ClearContents
    With Arkusz2.[B1].CurrentRegion.Rows
        For R = 4 To .Count
            For C = 1 To 3
                If .Cells(R, C).Value2 > "" Then
                    F = C * 4
                    L = L + 1
                    Arkusz1.Cells(L, 2).Resize(, 5).Value2 = Application.Index(.Item(R).Value2, , Array(C, F, F + 1, F + 2, F + 3))
                End If
            Next
        Next
    End With
         Application.ScreenUpdating = True
End Sub 

Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !

[Marc L]

Thanks for the rep' !