Suchen und Kopieren

Forumthread: Suchen und Kopieren

Suchen und Kopieren

13.05.2006 07:35:21

Ralf

Hallo Excel - Experten,
ich habe eine Tabelle, aus der teilweise Daten heraus-
kopiert werden sollen, daher suche ich
nach einem Makro, das in Spalte K nach x sucht, dann die entsprechende
Zeilen von A - L markiert und rot färbt und dann in Tabelle: Archiv nur den
Wert kopiert u. in Spalte M ( im Archiv ) noch das heutige Datum einträgt.
Dann suche ich noch ein zweites Makro, das alle rot gefärbten Zeilen zählt :-)
Hat jemand von Euch eine Idee hierzu ?
Wäre für jeden Hinweis dankbar !!!
Viele :-) Grüße
Ralf

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Suchen und Kopieren

13.05.2006 12:47:07

Franz
AW: Suchen und Kopieren

15.05.2006 08:59:11

Ralf
AW: Suchen und Kopieren

15.05.2006 10:00:52

Ralf

AW: Suchen und Kopieren

13.05.2006 12:47:07

Franz

Hallo Ralf,
hier zwei Makrolösungen für deine Fragen:

Sub X_Archivieren()
Dim Suchbereich As Range, Daten As Range, Finden As Range
Dim wks1 As Worksheet, Archiv As Worksheet, Adresse As String
Set wks1 = ActiveWorkbook.Sheets("Daten")
Set Archiv = ActiveWorkbook.Sheets("Archiv")
Set Suchbereich = wks1.Range("K2:K" & wks1.UsedRange.Row + wks1.UsedRange.Rows.Count - 1)
With Suchbereich
Set Finden = .Find(What:="X", LookIn:=xlValue, Lookat:=xlWhole, MatchCase:=False)
If Finden Is Nothing Then Exit Sub
Adresse = Finden.Address
Do
Set Daten = wks1.Range(wks1.Cells(Finden.Row, "A"), wks1.Cells(Finden.Row, "L"))
Daten.Interior.ColorIndex = 3 ' Farbe = rot
Daten.Copy
Zeile = Archiv.UsedRange.Row + Archiv.UsedRange.Rows.Count
Archiv.Cells(Zeile, "A").PasteSpecial Paste:=xlValues
Archiv.Cells(Zeile, "M").Value = Date
Set Finden = .FindNext(Finden)
Loop While Not Finden Is Nothing And Adresse <> Finden.Address
End With
Application.CutCopyMode = False
End Sub
Sub RoteZaehlen()
Dim wks1 As Worksheet, Zelle As Range, Zaehler As Long
Set wks1 = ActiveWorkbook.Sheets("Daten")
For Each Zelle In wks1.Range("K2:K" & wks1.UsedRange.Row + wks1.UsedRange.Rows.Count - 1)
If Zelle.Interior.ColorIndex = 3 Then Zaehler = Zaehler + 1
Next Zelle
MsgBox ("Es sind" & Zaehler & " Zeilen rot gefärbt.")
End Sub

Gruß
Franz

AW: Suchen und Kopieren

15.05.2006 08:59:11

Ralf

Hallo Franz,
vielen vielen Dank für Deine Mühe !!!
Das sieht schon sehr sehr gut aus.
Ich habe gerade Deinen Code in ein Modul kopiert und es mit
F8 laufen lassen, leider ist er immer bei Set Finden stehengeblieben.
Hast Du vielleicht eine Idee, woran dies liegen könnte ?
Gruß
Ralf

AW: Suchen und Kopieren

15.05.2006 10:00:52

Ralf

Hallo Franz,
Alarm zurück :-) ich mußte bei value nur ein s anhängen,
dann funkte es ganz toll --- nochmal vielen vielen Dank,
Du hast mir sehr geholfen. Dieses Forum ist echt Spitze !!!
Ich hoffe, das ich später auch mal so tolle Antworten
geben kann :-)
Gruß
Ralf

Beliebteste Forumthreads (12 Monate)

Forumthread: Suchen und Kopieren

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread