Kopieren von drei Zellen in eine andere Tabelle

Sub Button2_Click()
Dim rng As Range
Dim i As Long
Dim a As Long
Dim rng_dest As Range
Application.ScreenUpdating = False
i = 1
Set rng_dest = Sheets("Invoice data").Range("B:D")
' Find first empty row in columns B:D on sheet Invoice data
Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
i = i + 1
Loop
'Copy cells R6, R8, Q33 on sheet Invoice to Variant array
Set rng = Sheets("Invoice").Range("R6", "R8", "Q33")
' Copy rows containing values to sheet Invoice data
For a = 1 To rng.Rows.Count
If WorksheetFunction.CountA(rng.Rows(a))  0 Then
rng_dest.Rows(i).Value = rng.Rows(a).Value
'Copy total
Sheets("Invoice data").Range("D" & i).Value = Sheets("Invoice").Range("Q33").Value
'Copy Date
Sheets("Invoice data").Range("B" & i).Value = Sheets("Invoice").Range("R6").Value
'Copy Company name
Sheets("Invoice data").Range("C" & i).Value = Sheets("Invoice").Range("R8").Value
i = i + 1
End If
Next a
Application.ScreenUpdating = True
End Sub