Werte suchen, folgewerte in Tabelle kopieren

[Sagulum]

Hallo Profis und alle die Ahnung haben

Ich habe auf einem Tabellenblatt 4 Tabellen nebeneinander mit je 3 Spalten und rund 50 Zeilen. Die ersten Spalten jeder Tabelle habe ich zu einem Bereich zusammengefasst und kann dort mit einem Doppelklick ein x einfügen. Ich möchte jetzt diesen Bereich(alle 4 Tabellen) per Button nach x absuchen. Wird ein x gefunden sollen die Werte der zweiten und dritten Spalte hinter dem x, in eine zweispaltige Tabelle auf dem Tabellenblatt2 gespeichert werden. Beginn dieser Tabelle sollte ungefähr D10 sein. Der Vorgang soll sich wiederholen bis kein x mehr gefunden wird.

Schon mal vielen Dank
Es grüßt Sagulum           

[WillWissen]

Hi,

du solltest uns deine Tabelle zeigen (kein Bildchen!!!). Lade sie bitte hier hoch (wie es geht, steht hier:  http://www.clever-excel-forum.de/thread-326.html), denn deine Infos sind - zumindest für mich - für eine adäquate Hilfe zu dürftig. Falls du sensible Daten in deiner Mappe hast, solltst du sie unbedingt anonymisieren.

[Sagulum]

War wohl ein wenig knapp
 
Lade die Datei hoch. Ich will Datensätze zusammenstellen um sie auf einer Faxvorlage ausdrucken zu können. Ach ja auf jedes Fax passen nur rund 25 Datensätze. Es müssten bei Bedarf automatisch zwei Tabellen gefüllt werden.

Es grüßt Sagulum

[Sagulum]

Hier ist noch mal das Sagulum
Hier jetzt im Anhang, das Aussehen, wie ich mir das Projekt vorstelle.

Es grüßt Sagulum

[schauan]

Hallöchen,

Die einfachste, wenngleich nicht besonders professionelle Variante wäre, die Zeilen alle einzeln durchzugehen und wenn ein x gefunden wird, diese zu übertragen.  
Man könnte 2 verschachtelte Schleifen programmieren, die das tun

Im Prinzip so, mal fix hier notiert:

Code:

Sub Uebertragen
'Variablendeklaration
Dim iCnt1%, iCnt2%, iColFax%, iRowFax%
'Schleife ueber alle Bereiche
For iCnt=2 to 14 step 4
'Schleife ueber alle Zeilen
For iCnt2 = 7 to 56
'Wenn Zelle in erster Spalte des Bereiches ein x enthaelt, denn
If Cells(iCnt2,iCnt1).Value="x" Then
'Daten auf Fax-Seite uebertragen
'erste freie Fax-Zeile ermitteln
iRowFax=Sheets("Fax-Daten").Cells(Rows.count,5).end(xlup).Row+1
'bei erstem Eintrag in Zeile 27 wechseln
If iRowFax < 27 Then iRowFax=27
'Wenn Zeile 55 erreicht ist, dann Wechsel in Zweiten Bereich, Zeile 27
If iRowFax = 55 Then iRowFax=27:iColFax=30
'erste zelle uebertragen
Sheets("Fax-Daten").Cells(irowFax,iColFax).Value=Cells(iCnt2,iCnt1+1).Value
'zweite zelle uebertragen
Sheets("Fax-Daten").Cells(irowFax,iColFax).Value=Cells(iCnt2,iCnt1+2).Value
'Ende Schleife ueber alle Zeilen
Next
'Ende Schleife ueber alle Bereiche
Next
End Sub

[Sagulum]

Hallo Schauan
Erst mal vielen Dank, das du dich mit meinem Problem beschäftigt hast. Bin gerade von der Arbeit gekommen und zu müde um mich mit deinem Vorschlag zu befassen. Ich Melde mich bald wieder.
Viele Grüße Sagulum  :28:

[schauan]

Hallöchen,

ich habe den Code jetzt noch getestet und Fehler korrigiert.
Wenn Du den Code startest, musst Du auf der Daten-Seite sein. Aber da der Button zum Übertragen dort ist, gehe ich davon aus, dass das auch so sein wird.

Code:

Sub Uebertragen()
'Variablendeklaration
Dim iCnt1%, iCnt2%, iColFax%, iRowFax%
'erste Spalte auf Blatt Fax-Seite setzen
iColFax = 5
'Schleife ueber alle Bereiche
For iCnt1 = 2 To 14 Step 4
  'Schleife ueber alle Zeilen
  For iCnt2 = 7 To 56
    'Wenn Zelle in erster Spalte des Bereiches ein x enthaelt, denn
    If Cells(iCnt2, iCnt1).Value = "x" Then
      'Daten auf Fax-Seite uebertragen
      'erste freie Fax-Zeile ermitteln
      iRowFax = Sheets("Fax-Seite").Cells(Rows.Count, 5).End(xlUp).Row + 1
      'bei erstem Eintrag in Zeile 27 wechseln
      If iRowFax < 27 Then iRowFax = 27
      'Wenn Zeile 55 erreicht ist, dann Wechsel in Zweiten Bereich, Zeile 27
      If iRowFax = 55 Then iRowFax = 27: iColFax = 30
      'erste zelle uebertragen
      Sheets("Fax-Seite").Cells(iRowFax, iColFax).Value = Cells(iCnt2, iCnt1 + 1).Value
      'zweite zelle uebertragen
      Sheets("Fax-Seite").Cells(iRowFax, iColFax + 7).Value = Cells(iCnt2, iCnt1 + 2).Value
    'Ende Wenn Zelle in erster Spalte des Bereiches ein x enthaelt, denn
    End If
  'Ende Schleife ueber alle Zeilen
  Next
'Ende Schleife ueber alle Bereiche
Next
'Fertigmeldung
MsgBox "Fertig!"
End Sub

[Sagulum]

Hallo Schuan

Vielen Dank für deine Hilfe. Bis jetzt klappt es prima. Wenn sich dein Code auch in der Praxis bewährt, werden meine Kollegen und ich es in Zukunft wesentlich leichter haben.

Also noch mal vielen Dank vom Sagulum :28: :97: :98:

[Sagulum]

Hallo Schauan und alle die Interesse haben

Ich hab an dem Projekt noch ein wenig rumgebastelt und jetzt klappt es nicht mehr wie es soll. Um eine bessere Übersicht zu bekommen, wollte ich auf dem Fax Leerzeilen einfügen. Um variabel zu bleiben, wird bei Doppelklick in die ersten Spalten nicht nur ein x eingefügt, es wird auch geprüft ob die Zelle rechts daneben leer ist --> wenn ja kommt da auch ein x rein. nach dem Übertragen aufs Fax werden die kleinen x wieder entfernt. Im Code habe ich das ans ende von Uebertragen reingebastelt.
Jetzt wird aber nur noch das erste Fax gefüllt. Habs aber jetzt erst mit so viel Daten getestet, dass bei einem Durchgang beide Faxe benötigt werden. Vorher habe ich mit weniger Daten einfach mehrfach auf Übertragen geklickt. Da ging es. Im Anhang der aktuelle Stand der Datei.
Ich hoffe es gibt eine Lösung.

Viele Grüße Sagulum   :s

[Sagulum]

Hallo Excelfreunde

Habe es gelöst indem ich nur eine Fax-Vorlage verwende und auf der Daten-Seite einen Zähler eingebaut habe.

Viele grüße Sagulum