Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
748to752
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
748to752
748to752
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Bereich anpassen

Bereich anpassen
03.04.2006 15:17:14
Sebi
HI leute,
hab ein Makro über die Recherche gefunden, dass auch fast das macht was es soll; allerdings noch nicht ganz. Viellicht kann mir einer von euch Excel-Cracks weiterhelfen das Makro anzupassen. Das MAkro soll die Zellen der Spalte "A" vom Blatt "Calc_GF" mit den Zellen der Spalte "K" vom Blatt "Ctrl" vergleichen und bei einer Übereinstimmung, die komplette Spalte des Blattes "Calc_GF" auf das Blatt "TC" kopieren. Ok. Das funzt auch alles. Jetzt soll das Makro aber nur die Zellen "0-2000" auf dem Blatt "Calc_GF" vergleichen und das Ergebnis auch nur in den Bereich zwischen Zeile 0 und 2000 auf dem Blatt "TC" kopieren. KAnn mir bitte jemand helfen das MAkro anzupassen.
Danke. Grüße Sebi

Sub Vergleich1()
Dim I As Integer
Dim J As Integer
For I = 5 To Worksheets("Ctrl").Cells(Rows.Count, 11).End(xlUp).Row
For J = 11 To Worksheets("Calc_GF").Range("C1999").End(xlUp).Row
If Worksheets("Calc_GF").Cells(J, 1) = Worksheets("Ctrl").Cells(I, 11) Then
Worksheets("Calc_GF").Rows(J).COPY _
Destination:=Worksheets("TC").Range("A" & Worksheets("TC").Cells(Rows.Count, 1).End(xlUp).Row + 1)
End If
Next J
Next I
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bereich anpassen
03.04.2006 22:00:13
Gerd
Guten Abend Sebi,
probiere es mal so. Ob das hinkommt, hängt von deinen Datenstrukturen ab.
Dazu sagst Du nur sehr wenig.

Sub Vergleich1()
Dim I As Integer
Dim J As Integer
For I = 5 To Worksheets("Ctrl").Cells(Rows.Count, 11).End(xlUp).Row
For J = 1 To 2000
If Worksheets("Calc_GF").Cells(J, 1) = Worksheets("Ctrl").Cells(I, 11) Then
Worksheets("Calc_GF").Rows(J).COPY _
Destination:=Worksheets("TC").Range("A" & Worksheets("TC").Cells(Rows.Count, 1).End(xlUp).Row + 1)
End If
Next J
Next I
End Sub

Gruß Gerd
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige