VBA Einzelne Spalten in Blatt einfügen

Private Sub CommandButton1_Click() 'Bestellung erzeugen
Dim TB1, TB1Z1 As Integer, LR1 As Integer, SP As Integer, RNG As Range
Dim TB2, TB2Z1 As Integer, LR2 As Integer
Set TB1 = Sheets("Katalog")
Set TB2 = Sheets("Bestellung")
Set RNG = TB1.Columns("B:S") 'Bereich, der übertragen werden soll
TB1Z1 = 4 'erste Zeile mit Daten
TB2Z1 = 4 'erste Zielzeile
SP = 19 'Spalte mit Mengenangaben "F"
LR1 = TB1.Cells(TB1.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
With TB1.Cells(TB1Z1, SP).Resize(LR1 - TB1Z1 + 1, 1)
'Prüfen ob Mengen eingetragen wurden
If WorksheetFunction.Sum(.Cells) > 0 Then
'Reset Zieltabelle
LR2 = TB2.Cells(TB2.Rows.Count, "S").End(xlUp).Row  'Letzte Zeile
TB2.Cells(TB2Z1, 1).EntireRow.ClearContents 'erste zeile leeren
TB2.Cells(TB2Z1 + 1, 1).Resize(LR2, 1).EntireRow.Delete xlUp 'Rest löschen
'Nur Zeilen mit Menge übertragen
Intersect(RNG, .SpecialCells(xlCellTypeConstants, 3).EntireRow).Copy TB2.Cells( _
TB2Z1, 2)
'Positionen setzen
LR2 = TB2.Cells(TB2.Rows.Count, "S").End(xlUp).Row  'Letzte Zeile
With TB2.Cells(TB2Z1, 1).Resize(LR2 - TB2Z1 + 1, 1)
.FormulaR1C1 = "=ROW(R[-3]C)"
.Value = .Value
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Borders(xlEdgeBottom).Weight = xlMedium
End With
'Format aus Zeile 3 übertragen
TB2.Cells(TB2Z1, 1).EntireRow.Copy
TB2.Cells(TB2Z1, 1).Resize(LR2 - TB2Z1 + 1, 1).EntireRow.PasteSpecial Paste:= _
xlPasteFormats
Application.CutCopyMode = False
Else
MsgBox "Keine Daten gefunden !"
End If
End With
End Sub