Zellwert und Kommentar speichern

Sub MehrFachAuswahl() 'Rechnungsdaten speichern
Application.ScreenUpdating = False
Zellen_verbinden_aufheben
Dim LoLetzte1, LoLetzte2, LoI, LoJ As Long
LoJ = 1
With Worksheets("Speicher")
'   letzte Zeile in Tabelle Speicher
LoLetzte1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
'   Letzte Zeile in Aktiver Tabelle
LoLetzte2 = ActiveSheet.Range("E65536").End(xlUp).Row
For LoI = 2 To LoLetzte2
'   zeilen nicht kopieren die in Spalte B leer sind
'If Cells(LoI, 2) <> "" Then
Range(Cells(LoI, 1), Cells(LoI, 5)).Copy
.Cells(LoLetzte1, LoJ).PasteSpecial Paste:=xlValues, Operation:=xlNone
If LoJ > 250 Then
Application.CutCopyMode = False
Exit Sub
Else: LoJ = LoJ + 5
End If
Next LoI
End With
Application.CutCopyMode = False
Zellen_verbinden
Application.ScreenUpdating = True
End Sub