Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
796to800
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
796to800
796to800
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Kopieren in Tabellenblätter an Heide_Tr!

Kopieren in Tabellenblätter an Heide_Tr!
29.08.2006 09:47:57
Krutzler
Stelle diese Nachricht nochmal ins Forum, weil meine erste Anfrage bereits im Archiv ist und meine Antwort auf Deine Antwort nun nicht mehr sichtbar ist:
Erstmal recht herzlichen Dank für Deine rasche Hilfe, aber irgendwie tut sich bei mir da gar nichts :-(
Nochmal kurz zur Erklärung:
sobald sich in der Spalte EF unter anderem der Eintrag "Mo" oder "Di", ... oder "Sa" und in der Spalte EE "LN" findet, soll der Inhalt der Spalten ED bis EG der jeweiligen Zeile in das betreffende Tabellenblatt kopiert werden - zum Beispiel: ED4 bis EG4 sollte in die Blätter "LN-MO", "LN-DI", "LN-MI", "LN-DO", "LN-FR" kopiert werden, da in der Zelle EF4 "MoDiMiDoFr" steht, ED7 bis EG7 hingegen nur in die Blätter "LN-DI" und "LN-DO", da in der Zelle EF7 "DiDo" steht.
Dein Vorschlag funktioniert, so glaube ich, deshalb nicht, weil nur nach "Mo", "Di" ... "Sa" gesucht wird - ich hab zwar schon versucht nach "*Mo*", "*Di*" ... "*Sa" suchen zu lassen, funktioniert aber auch nicht :-(
Hoffe, daß ich mich nun klar ausgedrückt habe.
Danke!
lg Andreas
Das war Deine Antwort:
hallo Andreas,
eigentlich sieht Dein Code in Ordnung aus,
ED bis EG werden gelöscht, weil Du am Anfang für die ersten vier Tabellenblätter definierst:
For i = 1 To 4
Worksheets(i).Range("ED4:EG3000").Value = ""
Next i
Ich habe Deinen Code nachprogrammiert und dabei zusammengefasst:

Sub test()
Spaltenbeginn = 145  'hier ändern für EO z.B. Spaltenbeginn = 145
Spaltenende = 152    'hier ändern für EV z.B. Spaltenende = 152
Worksheets("Alle").Select
For Each Tag In Array("Mo", "Di", "Mi", "Do", "Fr", "Sa")
Zeile = 3
For i = 3 To Range("EF65536").End(xlUp).Row
If Range("EE" & i) = "LN" And InStr(1, Range("EF" & i), Tag) > 0 Then
For j = Spaltenbeginn To Spaltenende
Worksheets("LN-" & UCase(Tag)).Cells(Zeile, j) = Cells(i, j)
Next j
Zeile = Zeile + 1
End If
Next i
Next Tag
End Sub

und es ist eigentlich alles in Ordnung. Findet er in EF den Wochentag, kopiert er EO bis EV auf das betroffene Tabellenblatt. Das war doch Dein Ziel, nicht?
viele Grüße. Heide

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren in Tabellenblätter an Heide_Tr!
29.08.2006 11:23:36
Peter
Hallo Andreas,
ich glaube Zeile = 3 steht an der falschen Stelle und dadurch wird alles immer wieder überschrieben.
Versuch einmal die beigefügte Variante:

Sub test()
Dim Spaltenbeginn  As Integer
Dim Spaltenende    As Integer
Dim Tag            As Variant
Dim Zeile          As Long
Dim i              As Long
Dim j              As Integer
Spaltenbeginn = 145  'hier ändern für EO z.B. Spaltenbeginn = 145
Spaltenende = 152    'hier ändern für EV z.B. Spaltenende = 152
Worksheets("Alle").Select
Zeile = 3
For Each Tag In Array("Mo", "Di", "Mi", "Do", "Fr", "Sa")
'Zeile = 3
For i = 3 To Range("EF65536").End(xlUp).Row
If Range("EE" & i) = "LN" And InStr(1, Range("EF" & i), Tag) > 0 Then
For j = Spaltenbeginn To Spaltenende
Worksheets("LN-" & UCase(Tag)).Cells(Zeile, j) = Cells(i, j)
Next j
Zeile = Zeile + 1
End If
Next i
Next Tag
End Sub

Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.
Anzeige
AW: Kopieren in Tabellenblätter an Heide_Tr!
29.08.2006 12:22:37
Krutzler
Hallo Peter!
Ich hab mich mit dem Vorschlag von Heide ein wenig befasst und kann mittlerweile eine Erfolgsmeldung machen.
So schaut das Ding, welches jetzt funktioniert:
Spaltenbeginn = 1
Spaltenende = 4
Worksheets("Alle").Select
For Each Tag In Array("Mo", "Di", "Mi", "Do", "Fr", "Sa")
Zeile = 4
For i = 4 To Range("C3000").End(xlUp).Row
If Range("B" & i) = "LN" And InStr(1, Range("C" & i), Tag) > 0 Then
For j = Spaltenbeginn To Spaltenende
Worksheets("LN-" & UCase(Tag)).Cells(Zeile, j) = Cells(i, j)
Next j
Zeile = Zeile + 1
End If
Next i
Next Tag
Aber wenn ich meine Liste erweitere und weitere Spalten hinzufüge, hab ich das Problem, daß er mir die Daten in gleichen Spalten kopiert, aus denen sie aus der "Alle" gekommen sind, sprich wenn im Tabellenblatt "Alle" die Daten in den Spalten F bis I stehen kopiert er mir diese auch in den Zieltabellenblätter in die Spalten F bis I.
Gibt es da eine Möglichkeit, dies zum umgehen?
Hier mal die Ausbaustufe 2:

Sub test()
Spaltenbeginn = 1
Spaltenende = 4
Worksheets("Alle").Select
For Each Tag In Array("Mo", "Di", "Mi", "Do", "Fr", "Sa")
Zeile = 4
For i = 4 To Range("C3000").End(xlUp).Row
If Range("B" & i) = "LN" And InStr(1, Range("C" & i), Tag) > 0 Then
For j = Spaltenbeginn To Spaltenende
Worksheets("LN-" & UCase(Tag)).Cells(Zeile, j) = Cells(i, j)
Next j
Zeile = Zeile + 1
End If
Next i
Next Tag
Spaltenbeginn = 6
Spaltenende = 9
Worksheets("Alle").Select
For Each Tag In Array("Mo", "Di", "Mi", "Do", "Fr", "Sa")
Zeile = 4
For i = 4 To Range("H3000").End(xlUp).Row
If Range("G" & i) = "SN" And InStr(1, Range("H" & i), Tag) > 0 Then
For j = Spaltenbeginn To Spaltenende
Worksheets("SN-" & UCase(Tag)).Cells(Zeile, j) = Cells(i, j)
Next j
Zeile = Zeile + 1
End If
Next i
Next Tag
End Sub

Danke einstweilen!
lg Andreas
Anzeige
AW: Kopieren in Tabellenblätter an Heide_Tr!
29.08.2006 14:07:57
fcs
Hallo Andreas,
dann muss du für die Spaltennummer in der Zietabelle einen eigenen Zähler einfügen.
Gruß
Franz
Schaut dann etwa so aus:

Sub test()
Spaltenbeginn = 1 '1. zu übertragende Spalte in Alle
Spaltenende = 4 ' letzte zu übertragende Spalte in Alle
Worksheets("Alle").Select
For Each Tag In Array("Mo", "Di", "Mi", "Do", "Fr", "Sa")
Zeile = 4
For i = 4 To Range("C3000").End(xlUp).Row
If Range("B" & i) = "LN" And InStr(1, Range("C" & i), Tag) > 0 Then
SpalteZiel = 10 ' 1. zu füllende Spalte in Zieltabelle
For j = Spaltenbeginn To Spaltenende
Worksheets("LN-" & UCase(Tag)).Cells(Zeile, SpalteZiel) = Cells(i, j)
SpalteZiel = SpalteZiel + 1
Next j
Zeile = Zeile + 1
End If
Next i
Next Tag
End Sub

Falls du mehrfach diese Kopieraktionen für verschiedenen Spalten durchführen willst dann schlage ich folgende Variante vor, bei der die jeweiligen Spalten als Parameter an eine Subroutine übergeben werden. Dann muss der Code nicht ständig wiederholt werden.

Sub test()
Worksheets("Alle").Select
Call WerteUebertragen("EE", "LN", "EF", 134, 137, 1)
Call WerteUebertragen("G", "SN", "H", 6, 9, 7)
End Sub
Private Sub WerteUebertragen(SpaltePruef As String, Pruefwert As String, SpalteTag As String, _
SpalteBeginn As Integer, SpalteEnde As Integer, SpalteZiel As Integer)
'SpaltePruef = Spalte in der der zu prüfende Text steht, Angabe der Spalte als Buchstabe(n)
'Pruefwert = Wert auf den geprüft werden soll
'SpalteTag = Spalte in der die Wochentage stehen, Angabe der Spalte als Buchstabe(n)
'SpalteBeginn = 1. Spalte in Tabelle Alle aus der der Wert übertragen werden soll, Angabe als Zahl
'SpalteEnde = letzte Spalte in Tabelle Alle aus der der Wert übertragen werden soll, Angabe als Zahl
'SpalteZTiel = 1. Spalte in Tages-Tabelle in die der Wert übertragen werden soll, Angabe als Zahl
Dim Tag, Spalte As Integer, Zeile As Long
For Each Tag In Array("Mo", "Di", "Mi", "Do", "Fr", "Sa")
Zeile = 4
For i = 4 To Cells(Sheets("Alle").Rows.Count, SpalteTag).End(xlUp).Row
If Range(SpaltePruef & i) = Pruefwert And InStr(1, Range(SpalteTag & i), Tag) > 0 Then
Spalte = SpalteZiel ' 1. zu füllende Spalte in Zieltabelle
For j = SpalteBeginn To SpalteEnde
Worksheets("LN-" & UCase(Tag)).Cells(Zeile, Spalte) = Cells(i, j)
Spalte = Spalte + 1
Next j
Zeile = Zeile + 1
End If
Next i
Next Tag
End Sub

Anzeige
AW: Kopieren in Tabellenblätter an Heide_Tr!
29.08.2006 16:10:40
Krutzler
Hallo fcs!
Also das ist ja wirklich der Hammer!!!!
Mußte noch in der Zeile für die Ziel-Tabellenblätter eine kleine Änderung vornehmen, weil alle Daten nur in die LN-Blätter kopiert wurden, aber jetzt funktioniert das wie geschmiert!!!
Mein Hut ist gezogen, mein Knie gebeugt, mein Haupt gesenkt und ich sage vielen herzlichen Dank an alle für die Hilfe!
lg Andreas

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige