Werte in Zeile 1 suchen und komplette Spalte kopieren

[Carsten3011]

Hallo,
ich habe bereits mehrere Suchen gestartet bin aber leider nicht auf eine Lösung gestoßen.

Ich habe eine Tabelle aus einem laufenden Versuch, in Zelle 1 befindet sich die Nummer eines Auslesegerätes (z.B. 1-48), in Spalte A wird die Uhrzeit aufgezeichnet (alle 30 Sekunden ein Wert). Wenn ein Gerät läuft, wird jede 30 Sekunden ein Wert aufgezeichnet. Es kann also sein, dass die ersten Zeilen in einer Spalte leer sind und dann erst in Zeile 499 die Aufzeichnung beginnt.

Ich würde nun gerne die erste Zeile des Tabellenblattes nach der Gerätenummer durchsuchen und dann die gefüllten Zellen der Spalte kopieren und in die Auswertedatei kopieren, bzw, aus der Auswertedatei heraus eine Abfrage starten und die Daten eines Gerätes, ab der ersten Aufzeichnung, auslesen.

Gibt es hier vielleicht eine Möglichkeit?

Danke.

Viele Grüße
Carsten3011

[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