Werte in Zeile 1 suchen und komplette Spalte kopieren

[Flotter Feger]

Hallo,

wirfst du mal eben den Makro-Rkorder an, und zeichnest dir das auf, wie du das händisch machen würdest, hast du eigentlich schon, was du willst.

Code:

Sub Makro1()
'
' Makro1 Makro
'
    Range("A1:J1").Select
    Range("J1").Activate
    Selection.Find(What:="4", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Range("F1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.End(xlDown).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
End Sub

Wird der noch ein wenig aufgehübscht, dann sieht es so aus ...

Code:

Sub Makro2()
Dim rng As Range

With Worksheets(1)
    Set rng = .Range("A1:J1").Find(What:="4", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
    If Not rng Is Nothing Then
        rng.Select
        Selection.End(xlDown).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets.Add After:=ActiveSheet
        ActiveSheet.Paste
    End If
End With
End Sub