Code optimieren
Charly
Folgender Code macht zwar was er soll, ich denke aber das geht auch anders (professioneller).
Ich hoffe ihr könnt mir wieder mal helfen.
Sub Eintragen_Form2()
'Eintragen in Liste 2
Dim LetzteTab As Integer
LetzteTab = ActiveWorkbook.Sheets.Count
Dim ZeileAnfang As Integer
Dim ZeileAnfang2 As Integer
ZeileAnfang = Sheets("Liste_2").Cells(5000, 3).End(xlUp).Row + 1
ActiveSheet.Range("Q10:Q28").Copy
Sheets("Liste_2").Cells(ZeileAnfang, 1).PasteSpecial Paste:=xlValues
ActiveSheet.Range("R10:R28").Copy
Sheets("Liste_2").Cells(ZeileAnfang, 2).PasteSpecial Paste:=xlValues
ActiveSheet.Range("A10:A28").Copy
Sheets("Liste_2").Cells(ZeileAnfang, 3).PasteSpecial Paste:=xlValues
ActiveSheet.Range("G10:G28").Copy
Sheets("Liste_2").Cells(ZeileAnfang, 4).PasteSpecial Paste:=xlValues
ActiveSheet.Range("L10:L28").Copy
Sheets("Liste_2").Cells(ZeileAnfang, 5).PasteSpecial Paste:=xlValues
ActiveSheet.Range("K10:K28").Copy
Sheets("Liste_2").Cells(ZeileAnfang, 6).PasteSpecial Paste:=xlValues
' 2. Seite
Sheets(LetzteTab).Activate
ZeileAnfang2 = Sheets("Liste_2").Cells(5000, 3).End(xlUp).Row + 1
ActiveSheet.Range("Q36:Q58").Copy
Sheets("Liste_2").Cells(ZeileAnfang2, 1).PasteSpecial Paste:=xlValues
ActiveSheet.Range("R36:R58").Copy
Sheets("Liste_2").Cells(ZeileAnfang2, 2).PasteSpecial Paste:=xlValues
ActiveSheet.Range("A36:A58").Copy
Sheets("Liste_2").Cells(ZeileAnfang2, 3).PasteSpecial Paste:=xlValues
ActiveSheet.Range("G36:G58").Copy
Sheets("Liste_2").Cells(ZeileAnfang2, 4).PasteSpecial Paste:=xlValues
ActiveSheet.Range("L36:L58").Copy
Sheets("Liste_2").Cells(ZeileAnfang2, 5).PasteSpecial Paste:=xlValues
ActiveSheet.Range("K36:K58").Copy
Sheets("Liste_2").Cells(ZeileAnfang2, 6).PasteSpecial Paste:=xlValues
Call N_S_F 'Formeln in Liste_2 eintragen
End Sub
Gruss Charly