Ich hab wieder mal ein Problem:
Im Tabellenblatt "Alle" habe ich eine Liste über vier Spalten "Fil", "LG", "LN" und "FL".
Nun will ich diese Liste durchsuchen lassen und die Inhalte der restlichen Zellen in denen sich in der Spalte "LN" der Wert "Mo" zu finden ist in das Tabellenblatt "LN-MO" kopieren lassen, dann weiter mit "Di" bis "Sa"
Folgendes Makro hab ich mir aus einem anderen Makro, bei dem ein ähnliches Problem vorlag, zusammengebastelt:
Sub Test()
Dim Zeile, maxZeilen, Spaltenbeginn, Spaltenende As Double
maxZeilen = 3000
Spaltenbeginn = 134 'hier ändern für EO z.B. Spaltenbeginn = 145
Spaltenende = 137 'hier ändern für EV z.B. Spaltenende = 152
For i = 1 To 4
Worksheets(i).Range("ED4:EG3000").Value = ""
Next i
Zeile = 3
For i = 3 To maxZeilen
If Worksheets("Alle").Cells(i, 136).Value = "*Mo*" And Worksheets("Alle").Cells(i, 135).Value = "LN" Then
For j = Spaltenbeginn To Spaltenende
Worksheets("LN-MO").Cells(Zeile, j).Value = Worksheets("Alle").Cells(i, j).Value
Next j
Zeile = Zeile + 1
End If
Next i
Zeile = 3
For i = 3 To maxZeilen
If Worksheets("Alle").Cells(i, 136).Value = "*Di*" And Worksheets("Alle").Cells(i, 135).Value = "LN" Then
For j = Spaltenbeginn To Spaltenende
Worksheets("LN-DI").Cells(Zeile, j).Value = Worksheets("Alle").Cells(i, j).Value
Next j
Zeile = Zeile + 1
End If
Next i
Zeile = 3
For i = 3 To maxZeilen
If Worksheets("Alle").Cells(i, 136).Value = "*Mi*" And Worksheets("Alle").Cells(i, 135).Value = "LN" Then
For j = Spaltenbeginn To Spaltenende
Worksheets("LN-MI").Cells(Zeile, j).Value = Worksheets("Alle").Cells(i, j).Value
Next j
Zeile = Zeile + 1
End If
Next i
Zeile = 3
For i = 4 To maxZeilen
If Worksheets("Alle").Cells(i, 136).Value = "*Do*" And Worksheets("Alle").Cells(i, 135).Value = "LN" Then
For j = Spaltenbeginn To Spaltenende
Worksheets("LN-DO").Cells(Zeile, j).Value = Worksheets("Alle").Cells(i, j).Value
Next j
Zeile = Zeile + 1
End If
Next i
Zeile = 3
For i = 3 To maxZeilen
If Worksheets("Alle").Cells(i, 136).Value = "*Fr*" And Worksheets("Alle").Cells(i, 135).Value = "LN" Then
For j = Spaltenbeginn To Spaltenende
Worksheets("LN-FR").Cells(Zeile, j).Value = Worksheets("Alle").Cells(i, j).Value
Next j
Zeile = Zeile + 1
End If
Next i
Zeile = 3
For i = 3 To maxZeilen
If Worksheets("Alle").Cells(i, 136).Value = "*Sa*" And Worksheets("Alle").Cells(i, 135).Value = "LN" Then
For j = Spaltenbeginn To Spaltenende
Worksheets("LN-SA").Cells(Zeile, j).Value = Worksheets("Alle").Cells(i, j).Value
Next j
Zeile = Zeile + 1
End If
Next i
End Sub
Das einzige, was ich damit erreiche ist, daß die Spalten ED bis EG danach leer sind und sonst gar nichts.
Hier ist die Excel-Tabelle, falls ich mich unklar ausgedrückt habe:
https://www.herber.de/bbs/user/36079.xls
Bitte um Hilfe! Danke!
lg Andreas