How to extract values from column using Excel macro into another sheet

Question

I want to extract all "Invoice" values in new sheet (sheet2) column. Now I'm only able to get single value from Invoice (not getting all values).

Please find below code:

Sub MergeData()

a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a    
    If Worksheets("Sheet1").Cells(i, 4).Value = "Rechnungen / invoices" Then 

        Worksheets("Sheet1").Cells(i + 2, 4).Copy
        Worksheets("Sheet2").Activate
        b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Sheet2").Cells(b + 1, 3).Select
        ActiveSheet.Paste
        Worksheets("Sheet1").Activate          
    End If
Next
End Sub

Actually I am beginner with macros and I don't know how to add a loop and condition to get all values.

Layout:

Answer 1

Here is a way of looping. I am defining the row boundaries by where text is found.

Minimum row constraint:

Invoices will be after the cell that contains "Rechnungen / invoices"

Set startCell = .Columns("D").Find("Rechnungen / invoices")

Maximum row constraint:

Invoices will be stop before the cell that contains "Anzahl/ Quantity"

Set endCell = .Columns("D").Find("Anzahl/ Quantity")

Left to right constraint:

Invoices are known to be between columns D and F.

Cells with only values in:

.SpecialCells(xlCellTypeConstants)

---

Option Explicit
Public Sub Test()
    Application.ScreenUpdating = False
    Dim invoices As Object, currentCell As Range, startCell As Range, endCell As Range, loopRange As Range
    Set invoices = CreateObject("Scripting.Dictionary")

    With ThisWorkbook.Worksheets("Sheet1")
        Set startCell = .Columns("D").Find("Rechnungen / invoices")
        Set endCell = .Columns("D").Find("Anzahl/ Quantity")
        If startCell Is Nothing Or endCell Is Nothing Then Exit Sub
        If startCell.Row > endCell.Row Then Exit Sub
        Set loopRange = .Range("D" & startCell.Row + 1 & ":F" & endCell.Row - 1)
        If Application.WorksheetFunction.CountA(loopRange) = 0 Then Exit Sub
        For Each currentCell In loopRange.SpecialCells(xlCellTypeConstants)
            If Not invoices.exists(currentCell.Value) Then invoices.Add currentCell.Value, 1
        Next currentCell

        ThisWorkbook.Worksheets("Sheet2").Range("A1").Resize(invoices.Count, 1) = Application.WorksheetFunction.Transpose(invoices.keys)
    End With
    Application.ScreenUpdating = True
End Sub

Answer 2

Below code is also working

Sub MergeData()
a = Worksheets("Tabelle1").Cells(Rows.count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Tabelle1").Cells(i, 4).Value = "Rechnungen / invoices" Then
        c = 0
        For k = 4 To 6
            For J = 2 To 6
                If (IsNumeric(Worksheets("Tabelle1").Cells(i + J, k))) Then
                    Worksheets("Tabelle1").Cells(i + J, k).Copy
                    Worksheets("Tabelle2").Activate
                    b = Worksheets("Tabelle2").Cells(Rows.count, 1).End(xlUp).Row
                    Worksheets("Tabelle2").Cells(b + c, 3).Select
                    c = c + 1
                    ActiveSheet.Paste
                    Worksheets("Tabelle1").Activate
                End If
            Next
        Next
    End If
Next

End Sub