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

Alle Zellen mit best. Wert suchen & kopieren

Alle Zellen mit best. Wert suchen & kopieren
25.02.2007 17:21:33
NicoM
Hallo,
mit dem Makro-Rekorder bekomme ich folgendes Problem nicht in den Griff:
1. In einem Sheet alle Zellen suchen, die "ABC" enhalten;
2. die Zellen kopieren, die rechts neben den "ABC" - Zellen stehen;
3. Kopieren in Sheet 2 (ab A1) untereinander.
Weiß jemand Rat?
Gruß und herzlichen Dank im voraus,
NicoM

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

Betreff
Datum
Anwender
Anzeige
AW: Alle Zellen mit best. Wert suchen & kopieren
25.02.2007 18:20:00
EtoPHG
Hallo Nico,
Versuch's mal damit:

Option Explicit
Sub FindAndCopyRight()
Const strFind = "ABC"
Dim rng As Range, rngC As Range
Dim strFirst As String
Dim dx As Double
dx = 1
With ActiveSheet.UsedRange
Set rng = .Find(strFind, after:=Range("A1"))
If Not rng Is Nothing Then
strFirst = rng.Address
Do
rng.Offset(0, 1).Copy (Sheets(2).Cells(dx, 1))
dx = dx + rng.Cells.Count
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> strFirst
End If
End With
End Sub

Gruss Hansueli
AW: Alle Zellen mit best. Wert suchen & kopieren
25.02.2007 18:31:00
EtoPHG
Hallo Nico,
Kleine Verbesserung, das es auch aus einem Modul läuft:

Sub FindAndCopyRight()
Const strFind = "ABC"
Dim rng As Range, rngC As Range
Dim strFirst As String
Dim dx As Double
dx = 1
With ActiveSheet.UsedRange
Set rng = .Find(strFind, after:=.Cells(1, 1))
If Not rng Is Nothing Then
strFirst = rng.Address
Do
rng.Offset(0, 1).Copy (Sheets(2).Cells(dx, 1))
dx = dx + rng.Cells.Count
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> strFirst
End If
End With
End Sub

Gruss Hansueli
Anzeige
AW: Alle Zellen mit best. Wert suchen & kopieren
25.02.2007 20:48:46
NicoM
Hallo Hansueli,
allerherzlichsten Dank und Kompliment für Deine tolle Arbeit.
Die Makro läuft genau so, wie ich mir das vorgestellt habe.
VG
NicoM

307 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige