Office: (Office 2011 Mac) Text finden und kopieren

Hallo zusammen,
ich suche eine Lösung für den unterstehenden Code. Er funktioniert :) habe ich hier aus dem Forum.
Jetzt möchte ich das der Suchwert nicht in A7 ausgegeben wird, sondern an die erste freie Zeile.

Bin in VBA ein Neuling.
Kann mir hier jemand helfen?

Private Sub CB_MaKopieren_Click()
Dim TC As String
Dim Suchwert As Range


TC = "Frohs"


Set Suchwert = Worksheets("Mitglieder").Range("D9:D200").Find(TC)
If Suchwert Is Nothing Then
MsgBox "Wert " & TC & " nicht gefunden!"
Else
Suchwert.EntireRow.Copy
Worksheets("Frohs").Range("A7").PasteSpecial Paste:=xlPasteAll
End If

End Sub

 

Hi,

Code:

Private Sub CB_MaKopieren_Click()
    Dim TC As String
    Dim Suchwert As Range
    Dim lngLetzte As Long
    TC = "Frohs"
    With Worksheets("Frohs")
        lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        Set Suchwert = Worksheets("Mitglieder").Range("D9200").Find(TC)
        If Suchwert Is Nothing Then
            MsgBox "Wert " & TC & " nicht gefunden!"
        Else
            Suchwert.EntireRow.Copy .Cells(lngLetzte + 1, 1)
        End If
    End With
End Sub

Bis später,
Karin

 

Hallo Karin,
vielen Dank :) hat super funktioniert.
Jetzt werde ich versuchen das für die nächsten 49 Mitglieder noch einzuarbeiten.
Gruß
Reinhold

 

Hallo,
vielleicht kann mir hier jemand noch helfen.
Als VBA Anfänger fehlen mir jetzt die Kenntnisse.Das Substanzen von Beverly hat super funktioniert. Danke nochmals.
Jetzt dachte ich mit ich könnte das beliebig erweitern, da ich auf etwa 50 Namen komme.
Mit dem Versuch nur einen Namen in das Subjekt einzufügen bin ich schon gescheitert. ich habe es mal so probiert wie unten eingepflegt und es mit viele Anregungen aus dem Internet versucht. Ohne Erfolg!
Wäre schön wenn mir jemand helfen kann.
Gruß
Reinhold

Private Sub CB_MaKopieren_Click()

Dim MaFr As String
Dim SiMü As String
Dim Suchwert As Range
Dim lngLetzte As Long

MaFr = "Frohs"
With Worksheets("Frohs")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
Set Suchwert = Worksheets("Mitglieder").Range("D9:D200").Find(MaFr)
If Suchwert Is Nothing Then
MsgBox "Wert " & TC & " nicht gefunden!"
Else
Suchwert.EntireRow.Copy .Cells(lngLetzte + 1, 1)

SiMü = "Mueller"
With Worksheets("Mueller")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
Set Suchwert = Worksheets("Mitglieder").Range("D9:D200").Find(SiMü)
If Suchwert Is Nothing Then
MsgBox "Wert " & TC & " nicht gefunden!"
Else
Suchwert.EntireRow.Copy .Cells(lngLetzte + 1, 1)


End Sub

 

Hi Reinhold,

trage alle Namen in ein Array ein und laufe dann in einer For-Next-Schleife über alle Felder dieses Arrays:

Code:

Private Sub CB_MaKopieren_Click()
    Dim arrNamen()
    Dim lngZaehler As Long
    Dim Suchwert As Range
    Dim lngLetzte As Long
    arrNamen = Array("Frohs", "Mueller", "Meier") '<== hier alle Namen eintragen
    For lngZaehler = 0 To UBound(arrNamen())
        With Worksheets(arrNamen(lngZaehler))
            lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
            Set Suchwert = Worksheets("Mitglieder").Range("D9:D200").Find(arrNamen(lngZaehler))
            If Suchwert Is Nothing Then
                MsgBox "Wert " & arrNamen(lngZaehler) & " nicht gefunden!"
            Else
                Suchwert.EntireRow.Copy .Cells(lngLetzte + 1, 1)
            End If
        End With
    Next lngZaehler
End Sub

Bis später,
Karin

 

Hallo Karin,
ich bin begeistert:). Habe es eben mit einer Person probiert und hat super geklappt. DANKE
War im Grundlagenkurs nicht enthalten. Hast du einen Tipp für Buchmaterial?

Gruß
Reinhold

 

Hi Reinhold,

mit Literatur kann ich leider nicht dienen, meine VBA-Kenntnisse stammen nicht aus Büchern sondern ich habe sie mir durch Mitlesen und Nachbauen von Beispielen in Excel-Foren und natürlich durch try-and-error angeeigenet.

Bis später,
Karin