Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1092to1096
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
Inhaltsverzeichnis

Inhalt In Zellen suchen und kopieren

Inhalt In Zellen suchen und kopieren
Rainer
Hallo, ich habe folgendes Problem.
ich habe zwei Arbeitsblätter, in denen alle unsere Kundendaten drin sind.
Ich müsste nun für einen EMail-Newsletter die Namen und EMail-Adressen raussuchen und dann in ein neues Arbeitsblatt oder Sheet einfügen.
Manuell könnte das sehr langwierig werden um nicht zu sagen meine Lebensaufgabe!
Ich habe schon mal angefangen und folgendes Makro aufgesetzt! aber so nimmt er mir nur die ersten und geht dann weiter zum nächsten Blatt! Ich bräuchte aber alle Namen in dem Blatt!
Kann mir bitte jemand helfen! ich bin doch noch Anfänger! und lernwillig! Ich weiß das dies mit einer Schleife klappen sollte, aber keine Ahnung wie! Bitte nicht nur die Lösung sondern vielleicht auch den Weg!
Danke
Rainer
---
Sub test()
Dim diff As Range, werte As Range
Dim i As Integer
For i = 2 To ThisWorkbook.Sheets.Count
With Sheets(i).UsedRange
Set diff = .Find("Name", LookIn:=xlValues)
End With
If Not diff Is Nothing Then
Set werte = Range(diff.Offset(0, 1), diff.Offset(0, 1))
werte.Copy
With Sheets("Anschreiben")
.Range("A" & i & ":A" & i).PasteSpecial
End With
End If
Next i
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Inhalt In Zellen suchen und kopieren
30.07.2009 19:22:06
Josef
Hallo Rainer,
ungetestet,
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub test()
  Dim rng As Range, strFirst As String
  Dim intIndex As Integer, lngRow As Long
  
  'Startzeile in "Anschreiben"
  lngRow = 2
  
  For intIndex = 2 To ThisWorkbook.Sheets.Count
    With Sheets(intIndex)
      Set rng = Nothing
      strFirst = ""
      Set rng = .UsedRange.Find("Name", LookIn:=xlValues, After:=.UsedRange.SpecialCells(xlCellTypeLastCell))
      'Wenn Suchbegriff gefunden
      If Not rng Is Nothing Then
        'Adresse der ersten Fundstelle merken
        strFirst = rng.Address
        Do
          'Wert rechts neben der Fundstelle in "Anschreiben" eintragen
          Sheets("Anschreiben").Cells(lngRow, 1) = rng.Offset(0, 1).Value
          'Zeilenzähler hochzählen
          lngRow = lngRow + 1
          'Weitersuchen
          Set rng = .UsedRange.FindNext(rng)
          'Suche fortsetzen bis erste Fundstelle wieder erreicht
        Loop While Not rng Is Nothing And strFirst <> rng.Address
      End If
    End With
    'Nächstes Tabellenblatt
  Next
  
  Set rng = Nothing
End Sub

Gruß Sepp

Anzeige
AW: Inhalt In Zellen suchen und kopieren
31.07.2009 10:20:04
Rainer
Hallo Sepp,
funktioniert einwandfrei, jetzt muss ich nur noch raus finden, wie ich nicht nur eine Zelle kopier sondern gleich 4x2 Zellen!
Danke.
Gruß Rainer

321 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige