Public Sub suchen_kopieren()
Dim rngSpalte As Range, strSuchbegriff As String, Suchbegriff00010 As String, loLetzteQuelle As Long
Dim wsQuelle As Worksheet, wsZiel As Worksheet
Set wsQuelle = ThisWorkbook.Worksheets("CSV IMPORT")
Set wsZiel = ThisWorkbook.Worksheets("finish")
strSuchbegriff = "00020"
With wsQuelle
Set rngSpalte = Rows(1).Find(strSuchbegriff & "*", lookat:=xlWhole, LookIn:=xlValues, MatchCase:=True)
If Not rngSpalte Is Nothing Then
loLetzteQuelle = .Cells(.Rows.Count, rngSpalte.Column).End(xlUp).Row
.Range(.Cells(1, rngSpalte.Column), .Cells(loLetzteQuelle, rngSpalte.Column)).Copy _
wsZiel.Cells(2, 1)
Else
MsgBox "Spaltenüberschrift konnte nicht gefunden werden."
End If
End With
Set wsQuelle = Nothing: Set wsZiel = Nothing: Set rngSpalte = Nothing
Suchbegriff00010 = "00010"
With wsQuelle
Set rngSpalte = Rows(1).Find(Suchbegriff00010 & "*", lookat:=xlWhole, LookIn:=xlValues, MatchCase:=True)
If Not rngSpalte Is Nothing Then
loLetzteQuelle = .Cells(.Rows.Count, rngSpalte.Column).End(xlUp).Row
.Range(.Cells(1, rngSpalte.Column), .Cells(loLetzteQuelle, rngSpalte.Column)).Copy _
wsZiel.Cells(2, 2)
Else
MsgBox "Spaltenüberschrift konnte nicht gefunden werden."
End If
End With
Set wsQuelle = Nothing: Set wsZiel = Nothing: Set rngSpalte = Nothing
End Sub
|