Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
292to296
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
292to296
292to296
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Auswahl und Kopie erstellen nach Vorbedingung

Auswahl und Kopie erstellen nach Vorbedingung
11.08.2003 14:27:37
Thorsten
Hi,
ich habe folgendes Problem:
In dem Tabellenblatt 2 meines Workbooks befinden sich in Spalte A Zellen, die rot ausgefüllt sind (interior color). Diese stehen für doppelt vorhandene Werte.
Auf dem Tabellenblatt 1 lassen sich diese doppelten Werte verstreut in der Spalte N wiederfinden.
Was ich versuche zu erreichen, ist folgendes: Rot hinterlegten Werte aus dem Tabellenblatt2 sollen in der Spalte N (Tabellenblatt 1)wiedergefunden werden, und dann die jeweils entsrechenden Zeilen kopiert und auf ein anderes Tabellenblatt 3 kopiert werden.
Das heißt also, wenn zum Beispiel auf dem Tabellenblatt2 in der Spalte A der Wert 5 rot hinterlegt ist, dann soll auf dem Tabellenblatt 1 in der Spalte N alle Werte mit 5 gefunden werden. Steht zum Beispiel N in N 5 und N 23, dann sollen die Zeilen 5 und 23 kopiert werden und untereinander auf das Tabellenblatt 3 kopiert werden.
Ich hoffe, dass mir jemand bei diesem Problem helfen kann, danke im vorraus.
Mfg T.

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Auswahl und Kopie erstellen nach Vorbedingung
11.08.2003 15:27:07
WernerB.
Hallo Thorsten,
dieses Makro gehört in ein normales Standard-Modul:

Sub Thorsten()
Dim tx As String
Dim laR1 As Long, laR2 As Long, laR3 As Long, i As Long, j As Long
Application.ScreenUpdating = False
laR1 = Sheets("Tabelle1").Cells(Rows.Count, 14).End(xlUp).Row
laR2 = Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To laR2
If Sheets("Tabelle2").Cells(i, 1).Interior.ColorIndex = 3 Then
tx = Sheets("Tabelle2").Cells(i, 1).Value
For j = 1 To laR1
If Sheets("Tabelle1").Cells(j, 14).Value = tx Then
laR3 = Sheets("Tabelle3").Cells(Rows.Count, 14).End(xlUp).Row
If Sheets("Tabelle3").Cells(1, 14).Value = "" And laR3 = 1 Then laR3 = 0
Sheets("Tabelle1").Rows(j & ":" & j).Copy
Sheets("Tabelle3").Cells(laR3 + 1, 1).PasteSpecial Paste:=xlAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
Next j
End If
Next i
Application.ScreenUpdating = True
End Sub

Viel Erfolg wünscht
WernerB.
P.S.: Das Forum lebt auch von der Rückmeldung des Fragestellers!

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige