Liste per Kopie auf Arbeitsblätter aufteilen
28.08.2006 15:43:59
Krutzler
Ich hab folgende Frage schon letzte Woche gestellt, war dann allerdings ab Donnerstag nicht in PC-Reichweite und jetzt kann ich nur die Einträge ab 24. August sehen.
Ich habe eine Liste von Filialen mit Lager, Liefertagen und eine weitern Spalte - nun will ich per Makro diese Liste in der Spalte "Lieftg" nach "Mo" und in Spalte "LG" nach "LN" durchsuchen lassen und falls beides zutrifft sollen die Daten aus dem Bereich ED bis EG in das Blatt "LN-MO" kopiert werden, dann weiter mit "Di" ... bis "Sa" - hier ein kleiner Auszug der Datei: https://www.herber.de/bbs/user/36222.xls
Hab mir da schon etwas zusammengebastelt mit dem Erfolg, daß nach dem Starten die Spalten ED bis EG leer sind und sonst gar nichts:
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
Was mach ich falsch?
Danke für Eure Hilfe!
lg Andreas Krutzler