Suchen & anschließendes Splitten von Daten

[DergestiefelteKater]

Hallöchen,

ich könnte mal eure Hilfe gebrauchen.

Ich möchte ein Makro schreiben, mit dem ich in einer Quelldatei eine Zahl suchen kann & dann alle Einträge von den Zellen darüber bis zu der Zahl in meine Zieldatei kopiere.

Meine Quelldatei besteht aus 6 Spalten. In Spalte A steht in A1 erst mal die Überschrift, dann kommen verschiedene immer unterschiedliche Begriffe & dann am Ende eine Nummer die zu einer gewissen Aufgabe gehört. Danach kommen wieder unterschiedliche Begriffe, die dann zu der nächsten Nummer, die dann auch in Spalte A steht gehört. Jetzt will ich die Nummer eingeben, danach suchen & alle Daten die zu der Nummer gehören (Also die Daten von der Nummer die vorher kam bis zur gesuchten Nummer).

Hat irgendjemand einen Tipp wie ich das lösen könnte? ^^ Bisher ist mir noch nichts sinnvolles eingefallen..

Danke schonmal! 

(Mein Office ist momentan noch 03, bald '10)

[pepo1943]

Hallo Kater,
ich bin auch kein wahrer Könner, aber vielleicht hilft Dir die hochgeladene Musterdatei
Funktioniert nur, wenn die Suchnummern fortlaufend sind
Gruß
Pepo

[pepo1943]

Hallo Kater,
nimm nachstendes Makro, dabei müssen die Nummern auch nicht fortlaufend sein
Gruß
Pepo

Sub Makro1()
 
   
Application.ScreenUpdating = False

Dim Zelle As Range
Dim Wert As Single
Range("A1:A22").Select
Wert = Range("H20").Value
For Each Zelle In Selection
If Zelle.Value = Wert Then Zelle.Select
ActiveCell.Select
Next Zelle
ActiveCell.Offset(-6, 0).Range("A1:A7").Copy
Range("K1").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
   
   
   
End Sub

[DergestiefelteKater]

Hallöchen, wie ists denn hier bei deinem Programm, kopiert das immer nur die Zellen A1 - A7?
was bedeutet denn ActiveCell.Offset(-6, 0).Range("A1:A7").Copy?

[DergestiefelteKater]

also grundsätzlich ist das schon mal n guter anfang. ich versuch das mal weiterzubasteln. problem ist nur, ich ruf das macro in meiner zieldatei auf & kopiere aus einer quelldatei & mehr als nur die eine spalte sondern alle 6 spalten ^^ mal schauen ob ich das hinbekomme..

[DergestiefelteKater]

ich schon wieder xD

bei diesem ActiveCell.Offset(-6, 0).Range("A1:A7").Copy, wie kann ich denn da den bereich anpassen? so dass von A bis E alles kopiert wird was zur gesuchten zahl gehört? weil bei A7 wird ja dann immer nur ein 7er-block kopiert..

[pepo1943]

Hallo Kater,

ActiveCell.Offset(-6, 0).Range("A1:A7").Copy erreicht, dass von der aktiven Zelle  Zellen nach oben gerechnet wird und dann von dort aus der Bereich A1:A7 markiert wird.
Bei dir muss dann halt der gewünschte Bereich z. A1:F7 stehen bzw der Wert 1-7 für die Anzahl der zu übertragenden Zeilen und A-F für die Spalten.
Gruß
Peter

[DergestiefelteKater]

kann man das irgendwie variabel machen?... wenns zu jedem block unterschiedlich viele zeilen gibt?

[pepo1943]

Hallo Kater,

war jetzt einige Zeit außer Gefecht, daher die lange Antwortzeit. Nachstehen das Makro mit variablem Bereich.
Es funktioniert aber nur, wenn die Aufgabenummer in einer eigenen Spalte steht.
Sollte das nicht möglich sein musst Du entweder in der Orginaldatei die Spalte A einfügen und die Formel
                  =WENN(ISTFEHLER(WERT(B1));"";B1)
in alle betroffenen Zellen einfügen oder die komplette Datei in eine Zwischentabelle übertragen (Copy) und dort das dann erledigen.
Sicher gibt es einfachere Möglichkeiten, aber wie bereits am Anfang erwähnt bin ich auch nicht der große "Zampano"

Gruß
Peter

Sub Kopieren()

    Dim ZahlSuchen As Variant
    Dim ZahlDavor As Variant
    ZahlSuchen = Range("$H$20").Value
    ZahlDavor = Range("$H$20").Value - 1
   
    Range("K3:Q20").Select   ' Die max. mögliche Anzahl an Zeilen
    Selection.ClearContents
    Cells.Find(What:=ZahlDavor, After:=ActiveCell).Activate
    Range(ActiveCell.Offset(1, 6), ActiveCell.Offset(1, 0).End(xlDown)).Select
    Selection.Copy
    Range("K3").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   
End Sub