Hallo,
Makro1:
Habe ich richtig verstanden, hast Du zwei Tabellen: A=„Eingabe“
und B=„Einsatzplanung“. In B suchst Du die erste freie Zeile (z),
sodann sollen C1, B2, D2, B3, E1, B3, B6, B7 aus A nach B in die
Zellen (z,1), (z,2) … (z,7) übernommen werden. Nach der Über-
nahme sollen die Zellen C1 bis B7 im Blatt A gelöscht (? - den
Ausdruck „geklierte“ verstehe ich nicht) werden. Sind beide Blätter
in derselben Mappe? Ich gehe einmal davon aus. B3 kopierst Du
übrigens doppelt, gewollt? Falls in den Ursprungszellen Formeln
stehen, solltest Du mir ebenfalls Bescheid geben.
Sub Makro1()
Dim Quelle As Worksheet, Ziel As Worksheet
Dim z As Long, i As Integer
Dim Zellen(1 To 8) As Variant
'Hier legst Du Deine Daten fest
Const Tbl1 As String = "Eingabeblatt"
Const Tbl2 As String = "Einsatzplanung"
On Error Resume Next
Zellen(1) = "C1": Zellen(2) = "B2": Zellen(3) = "D2":
Zellen(4) = "B3": Zellen(5) = "E1": Zellen(6) = "B3":
Zellen(7) = "B6": Zellen(8) = "B7"
Application.ScreenUpdating = False
Set Quelle = ActiveWorkbook.Sheets(Tbl1)
Set Ziel = ActiveWorkbook.Sheets(Tbl2)
z = Ziel.UsedRange.Rows.Count
'Übernehmen nach Ziel
For i = 1 To 8
Ziel.Cells(z + 1, i).Value = Quelle.Range(Zellen(i)).Value
Next i
'Löschen in Quelle
For i = 1 To 8
Quelle.Range(Zellen(i)).Clear
Next i
Application.ScreenUpdating = True
Ziel.Activate
End Sub
Makro2:
Falls ich recht verstehe: im Datenblatt soll in der zu einem
Namen gefundenen Zeile ab der ersten freien Spalte der Inhalt
der Zellen B2, B3 und B4 aus dem Eingabeblatt geschrieben
werden. Der Name taucht dann in der Spalte A und in der ersten
freien Spalte nochmals auf, gewollt? Oder sollen nur Eintritts-
und Austrittsdatum übernommen werden? Ich gehe einmal davon
aus. - Ich würde nicht den Namen, sondern eine ID als Schlüssel
wählen, denn bei jedem Vertipper in der Eingabe landest Du in
der Fehlermeldung; Groß-Kleinschreibung unterscheiden ja/nein?
Ich schicke Dir den Code auf Deine eigene Gefahr. Übrigens:
„erste freie Spalte“ bedingt u.U., daß keine Lücken in der
Zeile sind. Der gelieferte Code positioniert ganz nach rechts.
Sub Makro2()
Dim Quelle As Worksheet, Ziel As Worksheet
Dim s As Integer, z As Long, i As Integer, ok As Boolean, Tx As String
'Hier legst Du Deine Daten fest
Const Tbl1 As String = "Eingabeblatt"
Const Tbl2 As String = "Datenbasis"
On Error Resume Next
Set Quelle = ActiveWorkbook.Sheets(Tbl1)
Set Ziel = ActiveWorkbook.Sheets(Tbl2)
z = Ziel.UsedRange.Rows.Count
ok = False
For i = 1 To z
If Quelle.Cells(2, 2).Value = Ziel.Cells(i, 1).Value Then
'Falls nicht case-sensitiv:
'if LCase(...) = UCase(...) then (auch Lcase geht)
ok = True
With Ziel
'letzte Zelle in Zeile:
s = .Cells(i, 255).End(xlToLeft).Column
.Cells(i, s + 1).Value = Quelle.Range("B3").Value
.Cells(i, s + 2).Value = Quelle.Range("B4").Value
'Ggf Datumsformat festlegen
.Cells(i, s + 1).NumberFormat = "yyyy-mm-dd"
.Cells(i, s + 2).NumberFormat = "yyyy-mm-dd"
End With
Exit For
End If
Next i
If Not ok Then
Tx = "Name " & Quelle.Range("B2").Value & " nicht vorhanden!"
MsgBox Tx, vbOKOnly, "Fehler"
Exit Sub
End If
Ziel.Activate
Set Quelle = Nothing
Set Ziel = Nothing
End Sub
Frohe Ostern!
gs
