Inhaltzellen kopieren?

Ahmadian · 1970-01-01T00:00:00+00:00

Hallo zusammen, ich bitte um Eure Hilfe! Folgendes: In Tabelle1 Zellen A1:A34 stehen die Arbeitszeiten wie folgt: 06:00 - 18:00 TO 06:00 - 18:00 T7 18:00 - 06:00 Au nun brauche ich einen VBA-Code, der die Arbeitszeiten mit den oben genannten Zeichen (TO/T7/Au)sucht und in den anderen Tabellen kopiert. Beispiel: Wenn in Tabelle1 A1:A34 die Dienste mit den Zeichen TO vorhanden sind, sollen diese in die Tabelle2 an den gleichen stellen, wie in Tabelle1 A1:A34 kopiert werden . Wenn in Tabelle1 A1:A34 die Dienste mit den Zeichen T7 vorhanden sind, sollen diese in die Tabelle3 an den gleichen stellen, wie in Tabelle1 A1:A34 kopiert werden . usw............. vielen Dank für eine kurze Rückmeldung! Mit freundlichen Grüßen Ahmadian

Hi Ahmadian,
probier mal:


Option Explicit
Sub kopiere2()
Dim zz As Long, ss As Long, wksZ As Worksheet
With Tabelle1
For ss = 1 To 27
For zz = 1 To 34
If .Cells(zz, ss)  "" Then
Select Case Right(.Cells(zz, ss), 2)
Case "TO": Set wksZ = Tabelle2
Case "T7": Set wksZ = Tabelle3
Case "Au": Set wksZ = Tabelle4
'                  Case Else: MsgBox "TO - T7 - AU nicht gefunden" ' evtl.
End Select
If Not wksZ Is Nothing Then wksZ.Cells(zz, ss) = .Cells(zz, ss)
Set wksZ = Nothing
End If
Next
Next
End With
End Sub

Bei den bisherigen Codes gibt es einen Fehler, wenn in einer der geprüften Zellen TO, T7 oder AU
nicht gefunden wird - dann ist myTab Nothing oder (noch schlimmer) die Tabelle vom letzten Treffer.
Noch eine Bemerkung: Das "With" steht besser vor den Schleifen als innerhalb.
Und noch eine Frage: Willst du mit den Codenamen oder den "sichtbaren" Blattnamen arbeiten?
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Hallo Erich
Das mit dem Fehler war mir noch garnicht aufgefallen, Danke.
Und mit dem With vor den Schleifen, hast Du vollkommen Recht :-)
Ich habs für mich jetzt mal so geändert:

Sub kopieren4()
Dim x&, j&, MyTab As Worksheet
With Tabelle1
For j = 1 To 27
For x = 1 To 34
If .Cells(x, j)  "" And (Right(.Cells(x, j), 2) = "TO" Or Right(.Cells(x, j), 2) = "T7"  _
Or Right(.Cells(x, j), 2) = "Au") Then
If Right(.Cells(x, j), 2) = "TO" Then Set MyTab = Tabelle2
If Right(.Cells(x, j), 2) = "T7" Then Set MyTab = Tabelle3
If Right(.Cells(x, j), 2) = "Au" Then Set MyTab = Tabelle4
MyTab.Cells(x, j) = .Cells(x, j)
End If
Next
Next
End With
Set MyTab = Nothing
End Sub

Sub kopieren5()
Dim RnG As Range, MyTab As Worksheet
For Each RnG In Tabelle1.Range("A1:AA34")
If RnG  "" And (Right(RnG, 2) = "TO" Or Right(RnG, 2) = "T7" Or Right(RnG, 2) = "Au")  _
Then
If Right(RnG, 2) = "TO" Then Set MyTab = Tabelle2
If Right(RnG, 2) = "T7" Then Set MyTab = Tabelle3
If Right(RnG, 2) = "Au" Then Set MyTab = Tabelle4
MyTab.Range(RnG.Address) = RnG
End If
Next
Set MyTab = Nothing
End Sub

scheint ja so auch zu klappen.
und Danke nochmal für die Infos!
Userbild

Forumthread: Inhaltzellen kopieren?

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Inhaltzellen kopieren?

Forumthread: Inhaltzellen kopieren?

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread