kopieren der jeweils ersten Zeile zu einer ID

JanetT · 2004-06-20T16:19:46+00:00

Hallo, ich habe in einer Tabelle folgendes Redundanz Problem. Ich habe zu jeder ID mehrere Zeilen benoetige aber nur die jeweils erste Zeile zu der jeweiligen ID. [Bild: Userbild] Gibt es eine moeglichkeit immer nur diese erste Zeile (die gelben im Screenshot zu kopieren) Vielen Dank, ich komme da leider ueberhaupt nicht weiter. JanetT

sorry Nancy, das hatte ich so nicht bedacht *schäm*, hier nun die neue Version, ich hoffe sie entspricht den Regeln besser *grien*
Lieben Gruß
Reinhard


Sub test2()
With Sheets("Tabelle1")
Sheets("Tabelle1").Activate
.Range(Cells(2, 1), Cells(.Range("A65536").End(xlUp).Row, 2)).Copy _
Destination:=Worksheets("Tabelle2").Cells(1, 1)
End With
With Sheets("Tabelle2")
Sheets("Tabelle2").Activate
.Range("C1").FormulaR1C1 = "1"
.Range("C2").FormulaR1C1 = "=IF(RC[-2]=R[-1]C[-2],0,1)"
.Range("C2").Copy
ActiveSheet.Paste Destination:=.Range("C2:C" & .Range("A65536").End(xlUp).Row)
Application.CutCopyMode = False
.Range("C1:C" & .Range("A65536").End(xlUp).Row).Copy
.Range("C1:C7").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
.Range("A1:C" & .Range("A65536").End(xlUp).Row).Sort _
Key1:=Range("C1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.CutCopyMode = False
For n = .Range("c65536").End(xlUp).Row To 1 Step -1
If .Cells(n, 3) = 0 Then Rows(n).Delete
Next n
Columns(3).Clear
End With
End Sub

Hallo Reinhard,
zum Teufel aber auch, das muss doch noch anders gehen,
ich hab mal noch ein Option Explicit reingenommen,
mich aber jetz grad sowas von verheddert ...
Nächtle & Gruss ;-)
Nancy
--
'möge man uns diese Albernheiten nachsehen


Sub groberUnfug()
Dim x&, y&, z&
If ActiveSheet.Name <> "Tabelle1" Then
MsgBox "falsche Starttabelle, check your pole-position"
Exit Sub
ElseIf ActiveSheet.Next.Name <> "Tabelle2" Then
MsgBox "falsche Tabellenkonstellation, bitte organisieren Sie Ihre Mappe neu"
Exit Sub
End If
For x = 2 To Range("A65536").End(xlUp).Row
If Cells(x, 1) <> Cells(x - 1, 1) Then
ReDim bla(1 To Cells(x, 256).End(xlToLeft).Column)
For y = 1 To Cells(x, 256).End(xlToLeft).Column
bla(y) = Cells(x, y).Value
Next
With ActiveSheet.Next
.Range(.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0), _
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row, UBound(bla)) = Application.Transpose(bla)
End With
End If
Next
End 

Sub

kopieren der jeweils ersten Zeile zu einer ID

Forumthread: kopieren der jeweils ersten Zeile zu einer ID

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

kopieren der jeweils ersten Zeile zu einer ID

Forumthread: kopieren der jeweils ersten Zeile zu einer ID

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread