Auswahl und Kopie erstellen nach Vorbedingung

Forumthread: 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

AW: Auswahl und Kopie erstellen nach Vorbedingung

11.08.2003 15:27:07

WernerB.

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!

Beliebteste Forumthreads (12 Monate)

Auswahl und Kopie erstellen nach Vorbedingung

Forumthread: Auswahl und Kopie erstellen nach Vorbedingung

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread