Code vereinfachen
13.08.2018 12:48:26
Guesa
Folgende Codeschnipsel habe ich mir zusammengebastelt und funktioniert sogar. Aber, ich müsste davon insgesamt 10 verschiedene Bereiche in Auswertung untereinander kopieren, und das müsste doch einfacher gehen. Ich bekomme es nicht hin das in einer Code-Anweisung aus der aktiven Zeile die Spalte A und E, F (F-I sind verbunden) und J kopiert werden (nur Werte) und anschließend in Auswertung Zeile 2 Spalte A - D eingefügt werden. Der nächste Bereich wäre dann Spalte A und K und L (L - O verbunden) kopieren und in Auswertung Zeile 2 in F - H eingefügt werden usw. Das wären die Einzelauswertungen. Nächstes Problem wäre dann, die 10 Bereiche die Variabel gefüllt sind am Ende der Tabelle z.B. ab Spalte AS untereinander zu Kopieren also Spalten A - D, F - H untereinander. Ich hoffe das ich das einigermaßen erklärt habe. Für Eure Hilfe schon mal ein Danke
Gruß, Guesa
Sub Auswertung1()
Application.ScreenUpdating = False
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 1)).Copy
Sheets("Auswertung").Cells(Sheets("Auswertung").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1). _
PasteSpecial xlPasteValues
'--------------A nach Auswertung A
Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 5)).Copy
Sheets("Auswertung").Cells(Sheets("Auswertung").Cells(Rows.Count, 2).End(xlUp).Row + 1, 2). _
PasteSpecial xlPasteValues
'--------------E nach Auswertung B
Range(Cells(ActiveCell.Row, 6), Cells(ActiveCell.Row, 6)).Copy
Sheets("Auswertung").Cells(Sheets("Auswertung").Cells(Rows.Count, 3).End(xlUp).Row + 1, 3). _
PasteSpecial xlPasteValues
'--------------F nach Auswertung C
Range(Cells(ActiveCell.Row, 10), Cells(ActiveCell.Row, 10)).Copy
Sheets("Auswertung").Cells(Sheets("Auswertung").Cells(Rows.Count, 4).End(xlUp).Row + 1, 4). _
PasteSpecial xlPasteValues
'--------------J nach Auswertung D
Application.CutCopyMode = False
Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 5)).Interior.ColorIndex = 35
Range(Cells(ActiveCell.Row, 10), Cells(ActiveCell.Row, 10)).Interior.ColorIndex = 35
Application.ScreenUpdating = True
End Sub