Mehere Zellen zu einer neuer Tabelle zusammenfügen mit Bedienung

Question

Hallo VBA Profis, könnt Ihr mir helfen.

Folgendes Problem hab ich:
Ich möchte mehrere Zellen aus einer Spalte in einer neuen Tabellenblatt zusammenfügen wenn eine Bedingung erfüllt ist und das für ca 30 Spalten.

Also wenn im Tabellenblatt "WZ Planung" in den Zellen E43,E48,E52,E56 der Wert Größer 0 ist dann möchte ich im Tabellenblatt "Manuell" die Zellen E38,E43,E48,E52,E56 unter Spalte B5 bis B10 kopiert haben. Wenn wert nicht Größer 0 dann schau in Spalte G
 Wenn dann im Tabellenblatt "WZ Planung" in den Zellen G43,G48,G52,G55 der Wert Größer 0 ist dann möchte ich im Tabellenblatt "Manuell" die Zellen G38,G43,G48,G52,G56 unter Spalte B5 bis B10 oder C5 bis C10. Wenn jedoch die Werte nicht größer 0 dann schaue in Spalte J ob da in den entsprechenden Zellen der wert größer 0 wenn ja dann kopiere in Spalte C5 bis C10. Das muss für ca 30 Spalten erfolgen. Und am Ende muss im Tabellenblatt "Manuell" eine Tabelle von B5 bis ca K10 sein.

Ich hoffe es ist verständlich mein Problem.Kann mir hier jemand mit einem Makro weiterhelfen?

Vielen Dank

Grüße jojo

Answer 1

Hallo jojo,

du schreibst

wenn im Tabellenblatt "WZ Planung" in den Zellen E43,E48,E52,E56 der Wert Größer 0

dann soll kopiert werden. Meinst du damit, dass in allen Zellen der Wert größer Null sein muss, damit diese kopiert werden, oder soll jede einzelne Zelle, deren Wert größer 0 ist kopiert werden?

Und wenn die Werte aus den einzelnen Zelle kopiert werden sollen, sollen diese dann direkt untereinander in den Bereich 5 bis 10 kopiert werden, oder entsprechend ihrer Position, also ggf. mit Leerzellen dazwischen.

Außerdem schreibst du

Wenn jedoch die Werte nicht größer 0 dann schaue in Spalte J ob da in den entsprechenden Zellen der wert größer 0

und dann

Und am Ende muss im Tabellenblatt "Manuell" eine Tabelle von B5 bis ca K10 sein.

Nach deiner ersten Aussage dürften die nächsten 30 Spalten (J und dann M, P ???) nur dann geprüft werden, wenn vorher überall 0 steht. Nach deiner zweiten Aussage soll aber eine Tabelle von B5 bis K10 (also nur 10 Spalten breit) herauskommen.

Erstelle doch mal eine Beispieltabelle mit dem gewünschten Ergebnis und lade sie auf eine Hoster deiner Wahl hoch (z.B. hier: https://filehorst.de/), damit man sich das mal anschauen kann.

Gruß

M.O.

Answer 2

Hallo Community :-)

Für unsere Vbafreaks ein Beispiel!

Gruß Nighty

Worksheets(1)

Autofilter!

Bedingung Spalte A + Spalte C

bzw

Bedingung Field1 + Field 3

Filterdaten nach Worksheets(2)

Sub Autofilter_mit_2_bedingungen()
       Worksheets(1).Range("A1:C3").AutoFilter
       Worksheets(1).Range("A1").AutoFilter Field:=1, Criteria1:=">0"
       Worksheets(1).Range("C1").AutoFilter Field:=3, Criteria1:=">0"
       Worksheets(1).AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Worksheets(2).Range("A2")
       Worksheets(1).Range("A1:C1").AutoFilter
End Sub

Answer 3

Hallo M.O.

ich habe mal eine Beispiel hochgeladen. Die Betreffenden Zellen habe ich Farbig markiert.

https://filehorst.de/d/cgHBpsEE

Datei von filehorst.de laden

Also wenn in der Spalte E die Zellen E43+E48+E52+E56 der Wert größer 0 ist sollen die Zellen E38,E43,E48,E52,E56 nach Tabellenblatt "Manuell" kopiert werden.

Dies soll für die Spalten E, G, J, L,Q U, Y, AA, AC, AE, AG, AI usw. erfolgen. Betrifft in den jeweiligen Spalten immer die selben Zellen.

Wenn in den Zellen E43+E48+E52+E56 der Wert 0 ist sollen keinen Zellen kopiert werden.

Im Tabellenblatt "Manuell" sollte dann eine kleine Tabelle mit den Zellen der jeweiligen Spalten stehen. 

Vielen Dank für Euer Hilfe

jojo

Answer 4

Hallo jojo,

probier mal das folgende Makro:

Sub uebertragen()

Dim lngZeile As Long
Dim lngSpalte As Long
Dim lngEinfspalte As Long

'erste Einfügespalte wird festgelegt
lngEinfspalte = 2

With ThisWorkbook.Worksheets("WZ Planung")
 
  'nun die Zeile 38 ab Spalte E durchlaufen
   For lngSpalte = 5 To .Cells(38, Columns.Count).End(xlToLeft).Column
    'Prüfen, ob in Zeile 38 etwas steht
    If IsEmpty(.Cells(38, lngSpalte)) = False Then
      'Prüfen, ob Summe größer 0
       If .Cells(43, lngSpalte).Value + .Cells(48, lngSpalte).Value + .Cells(52, lngSpalte).Value + .Cells(56, lngSpalte).Value > 0 Then
         Worksheets("Manuell").Cells(6, lngEinfspalte) = .Cells(38, lngSpalte)
         Worksheets("Manuell").Cells(7, lngEinfspalte) = .Cells(43, lngSpalte)
         Worksheets("Manuell").Cells(8, lngEinfspalte) = .Cells(48, lngSpalte)
         Worksheets("Manuell").Cells(9, lngEinfspalte) = .Cells(52, lngSpalte)
         Worksheets("Manuell").Cells(10, lngEinfspalte) = .Cells(56, lngSpalte)
         lngEinfspalte = lngEinfspalte + 1
        End If
    End If
  Next lngSpalte

End With

End Sub

Kopiere das Makro in ein Standard-Modul deiner Tabelle. Es wird die Tabelle in Zeile 38 durchlaufen, sobald dort etwas steht, wird geprüft, ob die Summe der Zellen 43, 48 ,52 und 56 größer Null ist. Falls ja werden die Daten übertragen. Ich habe aber keine Begrenzung der Übertragung nur bis Spalte K eingebaut, d.h. in deinem Beispiel wird auch noch die Spalte J mit Daten aus dem Arbeitsblatt WZ-Planung gefüllt.

Gruß

M.O.

Answer 5

Hallo M.O.,

vielen dank, dein Makro funktioniert super,

DANKE

Grüße jojo

Answer 6

Hallo jojo,

danke für die Rückmeldung.

Gruß

M.O.