VBA-Forum - Das Forum zu Microsoft VBA

VBA Excel VBA Word VBA Access VBA VBScript VB C# Objective-C C++ SQL JAVA VBA (English) Jobs Übersicht

Thema	Datum	Von Nutzer	Rating	Antwort
kopieren und einfügen	25.07.2017 09:37:45	j29
kopieren und einfügen	25.07.2017 11:00:48	Crazy Tom
kopieren und einfügen	25.07.2017 11:06:10	Gast55957
kopieren und einfügen	25.07.2017 11:07:36	j29
kopieren und einfügen	25.07.2017 11:38:34	Crazy Tom
kopieren und einfügen	25.07.2017 12:19:42	J29
kopieren und einfügen	25.07.2017 12:26:38	Crazy Tom
kopieren und einfügen	25.07.2017 13:02:32	J29
Danke für die Rückmeldung owT	25.07.2017 13:03:23	Crazy Tom
Danke für die Rückmeldung owT	27.07.2017 12:05:50	j29
klar doch	27.07.2017 12:16:58	Crazy Tom
klar doch	31.07.2017 14:48:26	j29

Ansicht des Beitrags:

Von:
Crazy Tom

Datum:
25.07.2017 12:26:38

Views:
674

Rating:

Antwort:

Thema:
kopieren und einfügen

Hallo

dann vielleicht so?

Sub test()
    Dim c As Range
    Dim lngZiel As Long
    Dim strFirst As String
    Dim strSuche As String
    strSuche = "DeinSuchbegriff"
    Application.ScreenUpdating = False
    On Error GoTo Fehler
    With Sheets("Zielblatt") 'Tabellenblattname anpassen
        lngZiel = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
'       gesucht wird in Spalte E (5) ggf. anpassen
'       Namen des Blattes in dem gesucht wird anpassen
        Set c = Sheets("Suchblatt").Columns(5).Find(strSuche, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            strFirst = c.Address
            Do
                Sheets("Suchblatt").Rows(c.Row).Copy
                .Cells(lngZiel, 1).PasteSpecial Paste:=xlValues
                lngZiel = lngZiel + 1
                Set c = Sheets("Suchblatt").Columns(5).FindNext(c)
            Loop While Not c Is Nothing And c.Address <> strFirst
        End If
    End With
    Application.CutCopyMode = False
Fehler:
    Application.ScreenUpdating = True
End Sub

MfG Tom

Ihre Antwort

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema:		Name:		Email:

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema	Datum	Von Nutzer	Rating	Antwort
kopieren und einfügen	25.07.2017 09:37:45	j29
kopieren und einfügen	25.07.2017 11:00:48	Crazy Tom
kopieren und einfügen	25.07.2017 11:06:10	Gast55957
kopieren und einfügen	25.07.2017 11:07:36	j29
kopieren und einfügen	25.07.2017 11:38:34	Crazy Tom
kopieren und einfügen	25.07.2017 12:19:42	J29
kopieren und einfügen	25.07.2017 12:26:38	Crazy Tom
kopieren und einfügen	25.07.2017 13:02:32	J29
Danke für die Rückmeldung owT	25.07.2017 13:03:23	Crazy Tom
Danke für die Rückmeldung owT	27.07.2017 12:05:50	j29
klar doch	27.07.2017 12:16:58	Crazy Tom
klar doch	31.07.2017 14:48:26	j29