Microsoft Excel

Herbers Excel/VBA-Archiv

suchen kopieren

Betrifft: suchen kopieren von: Herbert Greim
Geschrieben am: 01.09.2014 19:49:41


Hallo,

habe folgendes Problem.
Der Code unten sucht und kopiert mir Daten in ein anderes Tabellenblatt, leider aber nur in die gleiche Spalte, wie bekomme ich es hin, dass ich die Spalte bestimmen kann,wo es hinkopiert wird.Im Moment sucht er in A1 und kopiert in die Tabelle Mo auch in A1
Hoffe ich habe gut ausgedrückt.
und vielen Dank im Voraus

Sub LG_suchen()
        Dim rngAct As Range
        Dim strFindFirst As String
        Dim intLoopCount As Integer
        Dim varFind As Variant
        'Begrenzung des zu durchsuchenden Bereichs
        'auf Spalte C
        With ActiveSheet.Columns(1)
            '1. Übereinstimmung finden
            Set varFind = .Find(What:="g", After:=Range("A1"), _
                LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, _
                SearchDirection:=xlNext, MatchCase:=False)
            If Not varFind Is Nothing Then
                '1. Zelle für das Beenden der Do-Loop-Schleife merken
                strFindFirst = varFind.Address
                Do
                    'Treffer hochzählen
                    intLoopCount = intLoopCount + 1
                    'Zelle mit Suchkriterium in Tabelle2 an die gleiche
                    'Position kopieren.
                    Range(varFind.Address).Copy _
                        destination:=Sheets("Mo").Range(varFind.Address)
                    'nächste Zelle suchen
                    Set varFind = .FindNext(varFind)
                'Schleife ausführen, solange das Suchkriterium gefunden
                'wird und bis letztendlich wieder die 1. Zelle erreicht ist
                '(sonst würde es in einer Endlosschleife enden)
                Loop While Not varFind Is Nothing And varFind.Address <> strFindFirst
            End If
        End With
       
    End Sub


Gruß
Herby

  

Betrifft: AW: suchen kopieren von: Adis
Geschrieben am: 01.09.2014 20:05:15

Hallo

ich denke es ist eine einfache Lösung. Ersetze Range durch Cells(), varFind.Row gibt die Zeile an.
Dannach kann jede bliebige Spalte als Buchstabe angegeben werden. Hier im Beispiel die Spalte "C"

destination:=Sheets("Mo").Cells(varFind.Row, "C")

Gruss Adis


  

Betrifft: AW: suchen kopieren von: Herbert Greim
Geschrieben am: 01.09.2014 20:13:45

hallo Adis,

funktioniert 1 a, hab da aber noch ne Frage dazu.
der Code soll nicht nur nach einem Suchtext suchen wie beschrieben "g" sondern wenn in der Spalte A1 Herbert, Walter, Rudi usw steht soll er die auch finden und in die gleiche Spalte in Mo schreiben.
Gruß
Herby


  

Betrifft: AW: suchen kopieren von: Peter Feustel
Geschrieben am: 01.09.2014 21:52:40

Hallo Herby,

dann versuche es so:

Option Explicit

Sub LG_suchen()

Dim rngAct        As Range
Dim strFindFirst  As String
Dim intLoopCount  As Integer
Dim varFind       As Variant
Dim vSuchbegriff  As Variant
Dim iIndx         As Integer
          
          
   vSuchbegriff = Array("Herbert", "Walter", "Rudi")
'     Begrenzung des zu durchsuchenden Bereichs auf Spalte A
   With ActiveSheet.Columns(1)
      For iIndx = 0 To UBound(vSuchbegriff)
'           1. Übereinstimmung finden
         Set varFind = .Find(What:=vSuchbegriff(iIndx), After:=Range("A1"), _
            LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
            SearchDirection:=xlNext, MatchCase:=False)
         If Not varFind Is Nothing Then
'             1. Zelle für das Beenden der Do-Loop-Schleife merken
            strFindFirst = varFind.Address
            Do
'                 Treffer hochzählen
               intLoopCount = intLoopCount + 1
'                 Zelle mit Suchkriterium in Tabelle2 an die gleiche
'                 Position kopieren.
               Range(varFind.Address).Copy _
                  Destination:=Sheets("Mo").Cells(varFind.Row, "C")
'                  nächste Zelle suchen
               Set varFind = .FindNext(varFind)
'                 Schleife ausführen, solange das Suchkriterium gefunden
'                 wird und bis letztendlich wieder die 1. Zelle erreicht ist
'                 (sonst würde es in einer Endlosschleife enden)
            Loop While Not varFind Is Nothing And varFind.Address <> strFindFirst
         End If
      Next iIndx 'den nächsten Suchbegriff holen
   End With
         
End Sub
In der Variablen vSuchbegriff kannst Du beliebig viele Suchbegriffe eintragen.

Gruß Peter


  

Betrifft: AW: suchen kopieren von: Herbert Greim
Geschrieben am: 02.09.2014 04:28:58

Hallo Peter,

vielen Dank, funzt prima.

Vielen Dank

Herby


 

Beiträge aus den Excel-Beispielen zum Thema "suchen kopieren"