Spalte A aus 2 Zeilen Copy u. in 1 Zeile 2 Spalten schreiben

With Tabelle2 Range("A20").Value = "Überschrift auslesen" 'Zellenüberschrift (Z.B Schrauben) auslesen und in Tabelle8 Spalte "A20" schreiben. z = z + 1 ' 1 Zeile Runter, ab da stehen die kopierten Einträge. In dem Fall, ab Zeile 21 For Zeile = 427 To 4680 'ab zeile 427 stehen die relevanten Daten If .Cells(Zeile, 1).Value Like "Testartikel 007" Then 'Bezeichnung aus Tabelle2 auslesen, da stehen die Basisdaten .Rows(Zeile).Copy Destination:=Tabelle8.Rows(z) 'in Tabelle8 fortlaufend kopieren. Zeile = Zeile + 1 z = z + 1 End If Next Zeile End With

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

With sheets("Tabelle2") Z = 20 Sheets("Tabelle8").Cells(Z, "A").Value = "Überschrift auslesen" 'Zellenüberschrift (Z.B Schrauben) auslesen und in Tabelle8 Spalte "A20" schreiben. Z = Z + 1 ' 1 Zeile Runter, ab da stehen die kopierten Einträge. In dem Fall, ab Zeile 21 Set gefunden = .Range("A427:A" & Rows.Count).Find(what:="Testartikel 007") 'ab zeile 427 stehen die relevanten Daten Dim gefunden As Range Dim cl As Range If Not gefunden Is Nothing Then Set cl = gefunden.Offset(1, 0) Do 'Schleife If cl.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)" Then 'Wenn währungsformat .Rows(gefunden.Row).Copy Destination:=Sheets("Tabelle8").Rows(Z) 'in Tabelle8 fortlaufend kopieren. Zeile = Zeile + 1 Z = Z + 1 Exit Do End If Loop While Z 10000 'gegen Endlosschleife. Falls mal kein Betrag eingegeben ist. Else MsgBox "nicht gefunden", vbOKOnly + vbCritical End If End With

Hi MCO,

hier kommt alles nochmal neu.

Die Daten in Tabelle2, sind der Ursprung.
In Tabelle8 soll geschrieben/kopiert werden. Zelle A den Artikel, Zelle B gleiche Zeile, den Preis.

Benötigt werden nur Z.B das hier:

Zeile 15 - Metallschrauben Schlossschraube Edelstahl A4 M8X140
(Wobei der Suchbegriff, denke ich, sich nur auf Z.B. "Metallschraube" zu beziehen braucht. Alle Artikel Fangen so an.
Kopiert werden muss aber der gesamte Artikelname, Metallschrauben Schlossschraube Edelstahl A4 M8X140.

Zeile 16 -
Zeile 17 - 8814814018
Zeile 18 - 2,20
Zeile 19 - Metallschrauben Schlossschraube Edelstahl A4 M8X140

Kopieren also den Artikel, Zeile 15
16, 17, nicht
Zeile 18, den Preis. Wobei das Zeichen manchmal am Ende steht.
Zeile 19 nicht. Die ist ja schon aus Zeile 15 vorhanden

In dem was ich bisher ans laufen gebracht habe scheint mir das in einer Endlosschleife zu münden. Es läuft und läuft und läuft, findet und kopiert aber nichts.
Ist das mit dem Schleifenzähler evtl. nicht richtig so wie es ist?

Was bisher klappt, die Überschrift (Oberbegriff) wird gefunden und in Tabelle8 in Zeile 20 kopiert. So wie es soll.

Leider habe ich von Range, Sheet, Cells usw überhaupt keinen Plan. Das habe ich bisher nie gebraucht. Darum habe ich auch die Probleme klar zu kommen.

Für deine Hilfe bin ich dir echt dankbar.

Gekürzte Beispieldatei ist hier: https://www.herber.de/bbs/user/162436.xlsm

Code bisher:



Dim gefunden As Range

Dim cl As Range



Dim z As Integer

Dim zeile As Integer



z = 20 ' Ab Z=20 soll der erste gefundene Eintrag in Tabelle8 kopiert werden.



With Sheets("Tabelle2")

       Sheets("Tabelle8").Cells(z, "A").Value = "Metallschrauben"

       z = z + 2

        Set gefunden = .Range("A5:A" & Rows.Count).Find(what:="Metallschrauben")

     

    If Not gefunden Is Nothing Then

        Set cl = gefunden.Offset(1, 0)

        

        Do 'Schleife

            If cl.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)" Then 'Wenn währungsformat

                .Rows(gefunden.Row).Copy Destination:=Sheets("Tabelle8").Rows(z)        'in Tabelle8 fortlaufend kopieren.

                z = z + 1

                Exit Do               

            End If    

        Loop While z  10000 'gegen Endlosschleife. Falls mal kein Betrag eingegeben ist.        

        Else    

        MsgBox "nicht gefunden", vbOKOnly + vbCritical        

    End If

    

End With

Vielen Dank für deine Hilfe
Liebe Grüße

Sub schraubenfinden() Dim gefunden As Range Dim cl As Range Dim rng As Range Dim z As Integer z = 20 ' Ab Z=20 soll der erste gefundene Eintrag in Tabelle8 kopiert werden. suchbegriff = "Metallschrauben" With Sheets("Tabelle2") Set rng = .Range("A5:A" & Rows.Count) Set gefunden = rng.Find(what:=suchbegriff) If Not gefunden Is Nothing Then firstAddress = gefunden.Address Set cl = gefunden.Offset(3, 0) 'Preis betrachten Do 'Schleife If cl.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)" Then 'Wenn währungsformat gefunden.Copy Destination:=Sheets("Tabelle8").Range("A" & z) 'in Tabelle8 fortlaufend kopieren. cl.Copy Destination:=Sheets("Tabelle8").Range("B" & z) 'in Tabelle8 fortlaufend kopieren. z = z + 1 'nächste Zeile zum Eintragen End If Set gefunden = rng.FindNext(gefunden) 'nächster Artikel Set cl = gefunden.Offset(3, 0) 'nächster Preis zum prüfen Loop While Not gefunden Is Nothing And gefunden.Address > firstAddress 'alles durchlaufen solange es nicht wieder die 1. Adresse ist Else MsgBox "nicht gefunden", vbOKOnly + vbCritical End If End With Sheets("Tabelle8").Range("A:B").Columns.AutoFit End Sub

hi MCO,

da haben wir uns anscheinend gründlich missverstanden.
Ich glaubte mit der Aussage, "fortlaufend kopiert werden" wäre das klar.
Das war dann mein Fehler, Sorry.

Sheets("Tabelle8").Cells(z, "A").Value = "Metallschrauben"
Wieso schreibst du einen Begriff in deine Ergebnistabelle, wenn du eigentlich den Artikel kopieren möchtest?
Das ist nur eine Überschrift für die Spalte.

z = z + 2 Was soll das?
Set gefunden = .Range("A5:A" & Rows.Count).Find(what:="Metallschrauben")
Hier wird 1 Begriff gefunden. Suche Ende. Das scheinst du aber gar nicht zu wollen.
Das wird als Überschrift benutzt und in Zeile 20 geschrieben. Eine Zeile frei, dann fangen die Einträge an. Hat sonst keinen Nutzen. Siehe Demo-Blatt.

Kann es sein, dass du ALLE Metallschrauben mit Preis auf Tabelle 8 sehen möchtest?
Ja genau, so ist es.

Das es zu Missverständnissen gekommen ist tut mir leid. Woher sollte ich wissen was ihr alles benötigt. Natürlich habe ich Beiträge angesehen. Da sah ich aber meistens keine Beispieldateien etc.
Das ist mein erstes mal hier in dem Forum.

P.S. kopiert wird noch nix mit dem was du geschickt hast. Zwar wird was gemacht, der Suchbegriff auch gefunden, aber nicht kopiert.

Liebe Grüße

Beispiel hier: https://www.herber.de/bbs/user/162442.xlsm

Beliebteste Forumthreads (12 Monate)

Spalte A aus 2 Zeilen Copy u. in 1 Zeile 2 Spalten schreiben

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalte A aus 2 Zeilen Copy u. in 1 Zeile 2 Spalten schreiben

26 Beiträge zum Forumthread Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread