Bereich C5 bis C10 nach Text (Hans) abfragen. Wenn Text gefunden, 2 Zellen rechts davon kopieren

Question

Guten Tag mein Nahme ist Herbert. Bis jetzt gelingt es mir nicht folgendes Problem zu lösen.

Vielen Dank für einen Lösungsvorschlag.

Im Tabellenblatt (Januar) nach Text „Hans“ suchen. Bereich C5 bis C10. Wenn Text gefunden, 2 Zellen rechts davon kopieren und in Tabellen-Blatt (Test) in Zeile ab Zelle (C12) fortlaufend kopieren.

Answer 1

Hi Herbert,

z.B. so:

Sub Kopieren()
    Dim rngZelle As Range
    Dim lngErste As Long
    Set rngZelle = Worksheets("Januar").Range("C5:C10").Find("Hans", lookat:=xlWhole)
    If Not rngZelle Is Nothing Then
        With Worksheets("Test")
            lngErste = .Cells(Rows.Count, 3).End(xlUp).Row + 1
            If lngErste < 12 Then lngErste = 12
            rngZelle.Offset(0, 2).Copy .Cells(lngErste, 3)
        End With
    End If
End Sub

Bis später, Karin

Answer 2

Vielen Dank Karin. Leider macht das Mako überhaupt nichts.

Answer 3

Kann es sein, dass bei dir 2 Zellen weiter rechts, also in Spalte E, nichts steht? Dann wird logischerweise auch nichts kopiert.

Bis später, Karin

Answer 4

Hallo Karin Danke für die Rückmeldung. Fast nicht glaubhaft aber passiert. Nach einem Neustart des PC’s funktioniert das Makro macht aber noch nicht ganz was gewünscht. Nach gefundenem Text (Hans) wird der Zellwert rechts davon kopiert und wie gewünscht in Blatt(Test) in Zeile (12) in Zelle C kopiert. Gewünscht wären beide Werte rechts vom Text kopieren und in Blatt (Test) zu kopieren und in der Zeile (12) in Zellen C-D zu schreiben.

Weiter in Spalte nach Hans suchen und wieder beide Werte rechts davon Kopieren und in Zellen-E-F schreiben.

Nächster Hans u.s.w.

Lg Herbert

Answer 5

Hi Herbert,

ändere die Zeile

       rngZelle.Offset(0, 2).Copy .Cells(lngErste, 3)

in diese

       Range(rngZelle.Offset(0, 1), rngZelle.Offset(0, 2)).Copy .Cells(lngErste, 3)

Ich hoffe, dies entspricht deinen Vorstellungen.

Deine Fragestellung im Eröffnungsbeitrag war für mich als Außenstehenden, der dein genaues Vorhaben und deine Mappe nicht kennt, leider nicht ganz EINdeutig zu interpretieren - ich hatte es so verstanden, dass nur der Wert aus der 2. Zelle rechts daneben übertragen werden soll. Deine Formulierung im letzten Beitrag dagegen war korrekt und eindeutig.

Bis später, Karin

Answer 6

Vielen Dank für deine Hilfe. Es ist nicht so einfach zu beschreiben was ich möchte. Im Blatt (Januar) in Spalte C stehen Nahmen. In Spalte D und E Zahlen. Es soll im Spaltenbereich C15 bis C40 nach "Hans" gesucht werden. Die Werte rechts davon (aus D und E) sollen kopiert werden und in Blatt (Test) in C12 und D12 geschrieben werden. Wieder aus Blatt (Januar) Spalte C den nächsten Wert "Hans" suchen wieder die Werte rechts davon (aus D und E) kopieren und in Blatt "Test" in Zellen E12 und F12 geschrieben werden. Weiter nach "Hans" suchen und in Blatt "Test" in G12 und H12 schreiben. Also fortlaufend in gleiche Zeile schreiben.

Herzlichen Dank für deine Hilfe.

Mfg Herbert

Answer 7

Hi Herbert,

es geht also darum, dass im Bereich C15:C40 und nicht im Bereich C5:C10 gesucht werden soll, außerdem kommt der Suchbegriff "Hans" mehrfach vor und es soll nicht AB Zeile 12 UNTEREINANDER sondern IN Zeile 12 jeweils NEBENEINANDER kopiert werden? Das ist nun aber eine ganz andere Aufgabenstellung...

Sub Kopieren()
    Dim rngZelle As Range
    Dim intSpalte As Integer
    Dim strStart As String
    intSpalte = 3
    With Worksheets("Januar")
        Set rngZelle = .Range("C15:C40").Find("Hans", lookat:=xlWhole)
        If Not rngZelle Is Nothing Then
            strStart = rngZelle.Address
            Do
                .Range(rngZelle.Offset(0, 1), rngZelle.Offset(0, 2)).Copy Worksheets("Test").Cells(12, intSpalte)
                Set rngZelle = .Range("C15:C40").FindNext(rngZelle)
                intSpalte = intSpalte + 2
            Loop While rngZelle.Address <> strStart
        End If
    End With
End Sub

Bis später, Karin

Answer 8

Hallo Karin vielen vielen herzlichen Dank. Absolut Spitze. Dieses Makro macht genau was ich möchte.

Ich wünsche dir ein schönes Wochenende und eine gute Zeit.

Nochmals herzlichen Dank.

Mfg. Herbert

Answer 9

Guten Tag Karin

Ich brauche deine Hilfe noch einmal. Selber kann ich es wider nicht lösen.

Folgende Zeile hat ja super funktioniert.

Set rngZelle = .Range("C15:C40").Find("Hans", lookat:=xlWhole)

Nun möchte ich noch eine Zusatzabfrage:

Wenn     .Range("A15:A40").Find("5", und .Range("C15:C40").Find("Hans", lookat:=xlWhole)

dann

Vielen herzlichen Dank für deine Hilfe

Mfg Herbert

Answer 10

Guten Tag

Ich brauche wieder euere Hilfe. Selber kann ich es wider nicht lösen.

Folgende Zeile hat ja super funktioniert.

Set rngZelle = .Range("C15:C40").Find("Hans", lookat:=xlWhole)

Nun möchte ich noch eine Zusatzabfrage:

Wenn     .Range("A15:A40").Find("5", und .Range("C15:C40").Find("Hans", lookat:=xlWhole)

dann

Vielen herzlichen Dank für eure Hilfe

Mfg Herbert