Macro regels kopiëren naar tabblad en nieuwe regel

Sub SjonR()
With Sheets("CSG ADRESSEN BESTAND")
    LR1 = .Range("A" & Rows.Count).End(xlUp).Row + 1
    LR2 = Range("B" & Rows.Count).End(xlUp).Row - 20
    .Cells(LR1, 1).Resize(LR2, 11).Value = Cells(21, 2).Resize(LR2, 11).Value
End With
End Sub

Sub Doorkopieren()
   For Each c In Sheets("macro").Range("B21:B34").Cells
      If Len(c.Value) > 0 Then
         Sheets("csg Adressen bestand").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 11).Value = c.Resize(, 11).Value
      End If
   Next
End Sub

Sub VenA()
  ar = Sheets("CSG - BEDRIJF").UsedRange
  ReDim ar1(10, 0)
  For j = 1 To UBound(ar)
    If ar(j, 1) = "Contacten:" Then
      x = Array(ar(j - 1, 11), ar(j - 2, 11), ar(j - 2, 1), ar(j - 2, 5), ar(j - 2, 6), "land")
     Else
      If ar(j, 11) = "" And ar(j, 1) <> "" Then
        ar1(0, t) = x(0)
        ar1(1, t) = x(1)
        ar1(2, t) = x(2)
        ar1(3, t) = ar(j, 1)
        ar1(4, t) = ar(j, 4)
        ar1(5, t) = x(3)
        ar1(6, t) = x(4)
        ar1(7, t) = x(5)
        ar1(8, t) = ar(j, 6)
        ar1(9, t) = "tel2"
        ar1(10, t) = ar(j, 9)
        t = t + 1
        ReDim Preserve ar1(10, t)
      End If
    End If
  Next j
  Sheets("CSG ADRESSEN BESTAND").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(t, 11) = Application.Transpose(ar1)
End Sub