Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1636to1640
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Code vereinfachen

Code vereinfachen
13.08.2018 12:48:26
Guesa
Hallo Forum
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

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code vereinfachen
13.08.2018 13:22:54
ChrisL
Hi
Zwei Varianten:
Sub Auswertung1()
Dim lZ As Long
Application.ScreenUpdating = False
With Worksheets("Auswertung")
lZ = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lZ, 1) = Cells(ActiveCell.Row, 1)
.Cells(lZ, 2) = Cells(ActiveCell.Row, 5)
.Cells(lZ, 3) = Cells(ActiveCell.Row, 6)
.Cells(lZ, 4) = Cells(ActiveCell.Row, 10)
End With
Cells(ActiveCell.Row, 5).Interior.ColorIndex = 35
Cells(ActiveCell.Row, 10).Interior.ColorIndex = 35
Application.ScreenUpdating = True
End Sub
Sub Auswertung2()
Dim lZ As Long, arrSpalten As Variant, i As Integer
arrSpalten = Array(1, 5, 6, 10) 'hier anpassen
Application.ScreenUpdating = False
With Worksheets("Auswertung")
lZ = .Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = LBound(arrSpalten) To UBound(arrSpalten)
.Cells(lZ, i + 1) = Cells(ActiveCell.Row, arrSpalten(i))
Next i
End With
Cells(ActiveCell.Row, 5).Interior.ColorIndex = 35
Cells(ActiveCell.Row, 10).Interior.ColorIndex = 35
Application.ScreenUpdating = True
End Sub
cu
Chris
Anzeige
AW: Code vereinfachen
13.08.2018 14:06:57
Guesa
Hallo ChrisL
Danke für die schnelle Antwort funktioniert, das hilft schon mal ein Stück weiter. Hättest du eventuell auch noch eine Lösung für mein zweites Problem?. Also Variable Bereiche untereinander zu kopieren in meinem Fall wäre das ja
A2 - D letzte Beschriebene in Spalte AS2 - AV2 darunter dann
F2 - H letzte beschriebene
Gruß, Guesa
AW: Code vereinfachen
13.08.2018 14:09:45
ChrisL
Hi
.Range(.Cells(lZ, "AS"), .Cells(lZ, "AV")) = .Range(Cells(ActiveCell.Row, "A"), Cells(ActiveCell.Row, "D")).Value
cu
Chris
AW: Code vereinfachen
13.08.2018 14:19:43
ChrisL
Mist... ein Punkt zuviel
.Range(.Cells(lZ, "AS"), .Cells(lZ, "AV")) = Range(Cells(ActiveCell.Row, "A"), Cells(ActiveCell.Row, "D")).Value
Anzeige
AW: Code weiter vereinfachen
13.08.2018 14:31:21
Daniel
noch einfacher:
.cells(IZ, "AS").Resize(, 4) = Cells(ActiveCell.Row, 1).Resize(, 4)
Gruß Daniel
AW: Code weiter vereinfachen
13.08.2018 17:53:23
ChrisL
Hi Daniel
Danke für den Hinweis. Resize vergesse ich gerne.
cu
Chris
AW: Code weiter vereinfachen
14.08.2018 09:57:11
Guesa
Hallo Chris und Daniel
Danke für Eure Rückmeldung
Sehr wahrscheinlich stelle ich mich da nicht so geschickt an. Bekomme die Fehlermeldung
"Unzulässiger oder nicht ausreichend definierter Verweis"
Aber ich seh gerade das die Dim IZ Anweisung da auch steht, als unwissender gehe ich jetzt mal davon aus das diese Zeile in den davorigen Code mit eingebunden ist. Ich möchte gerne das diese einzelnen Bereiche A-D, F-H und die da noch kommenden Bereiche mit einem eigenen Code untereinander kopiert werden, beim nächsten kopieren dieser gesamt Bereich wieder überschrieben wird, damit ich dann dort eine gesamt Auswertung vornehmen kann. Falls ich da jetzt Blödsinn erzählt haben sollte, nehmt es mir nicht übel, unwissend halt.
Danke für Eure Mühe
Gruß, Guesa
Anzeige
Bitte Beispieldatei owT.
14.08.2018 10:22:30
ChrisL
.
AW: Bitte Beispieldatei owT.
14.08.2018 11:24:31
ChrisL
Hi
Sub t()
Dim lZ As Long
With ActiveSheet
lZ = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A3:D" & lZ).Copy .Cells(Rows.Count, 15).End(xlUp).Offset(1, 0)
lZ = .Cells(Rows.Count, 6).End(xlUp).Row
.Range("F3:H" & lZ).Copy .Cells(Rows.Count, 15).End(xlUp).Offset(1, 0)
lZ = .Cells(Rows.Count, 10).End(xlUp).Row
.Range("J3:M" & lZ).Copy .Cells(Rows.Count, 15).End(xlUp).Offset(1, 0)
End With
End Sub
cu
Chris
Anzeige
AW: Bitte Beispieldatei owT.
14.08.2018 11:27:31
Guesa
Hi Chris
Shit habe ich vergessen, beim nächsten kopieren sollte die Gesamtauswertung wieder überschrieben werden.
Gruß, Guesa
AW: Bitte Beispieldatei owT.
14.08.2018 11:34:53
Guesa
Hi Chris
Wow bist du schnell, Danke dir recht herzlich für Deine Mühe
Gruß, Guesa

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige