Wir wünschen allen Forenteilnehmern ein frohes Fest und einen guten Rutsch ins neue Jahr. x

per VBA Zellen in bestimmte Bereich kopieren
#1
Hallo,

ich scheitere an bestimmt einer leichten Kleinigkeit, ich versuche einen Schichtplan zu erstellen. Da habe ich ein  Arbeitsblatt "Eingabe" wo das Datum "von" "bis" mit einer Formel ausgegeben wird. Jetzt möchte ich dieses Datum auf dem Arbeitsblatt "Dienst" dem jeweiligen Fahrer zuordnen und rüber kopieren ohne das ich die vorhandenen Daten lösche. Die Zellen die kopiert werden sollen sind von der Anzahl her variabel. Wie man direkt sieht bin ich nicht so der Fachmann in Excel, aber ich versuche dazu zu lernen. Es wäre klasse wenn mir jemand helfen kann mit ein paar Fußnoten damit ich es verstehe.

Vielen Dank im voraus

Gruß


Angehängte Dateien
.xlsm   Schichtplan.xlsm (Größe: 743,41 KB / Downloads: 16)
Antworten Top
#2
Hallo,
hier ein Vorschlag. Ich weiß nicht, warum erst im Blatt EIngabe eingefügt werden muss, ist eigentlich nicht notwendig
Code:
Option Explicit 'damit wird das Vereinbaren von Variablen erzwungen

Sub übertragen()
Dim i As Long
  With Sheets("Eingabe")
    'damit werden alle folgenden Berecihe mit vorangestelltem Punkt auf das Sheet Eingabe referenziert
    .Columns(7).ClearContents 'alte Inhalte in Spalte G löschen
    .Range(.Cells(3, 6), .Cells(.Cells(Rows.Count, 6).End(xlUp).Row, 6)).Copy 'man muss nicht vorher selektieren
    'mit Cells(Rows.Count, 6).End(xlUp).Row bestimme ich die letzte belegte Zeile in Spalte 6
    .Range("G3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  End With
  With Sheets("Dienst")
    i = .Cells(Rows.Count, 1).End(xlUp).Row 'letzte belegte Zeile in Dienst in Spalte 1
    'das Gleiche wie vorher einfügen
    .Cells(i + 1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False
    .Activate 'Blatt anzeigen
    .Cells(i + 1, 1).Select 'hier darf man mal
  End With
End Sub
Gruß der AlteDresdner (Win11, Off2021)
Antworten Top
#3
Hallo

der Kollege hat schon einen Code angeboten, wo ich etwas verdutzt bin???
Ob man die Werte in Spalte G braucht ist fraglich, ich glaube Nein. Überflüssig.
In Spalte F sind aber Formeln!  Die sollten m.E. nicht überschrieben werden.

Was ich vermisse ist ein Hinweis auf die Fahrer Nummer und den Fahrer! In der Eingabe steht Kremer.
In allen anderen Tabellen erscheint aber nur a,b,c oder die Nummer, 100, 101. Wo finde ich jetzt Kremer???
Die Daten einfach in die nächste leere Spalte schreiben kann richtig sein.  Ich habe da aber meine Zweifel.
Die Fahrer Nummer sollte auch irgendwo im Eingabeblatt stehen.  Aber in welcher Zelle?? Ich sehe keine.

mfg Gast 123
Antworten Top
#4
Hallo,
im Bild ist zu sehen wo der Fahrer ist, Kremer ist nicht mehr drinnen, habe die Namen gegen Buchstaben ausgetauscht. Vielen Dank für den Code, aber leider Funktioniert der Code nicht. Er schreibt das nächste Datum erst in Zelle 8000 dazwischen nur leere Zellen, und es fehlt mir leider noch die Zuordnung zum Fahrer. Aktuell wir alles dem Fahrer a (101) zugeordnet.

Eventuell noch eine Idee?

Gruß


Angehängte Dateien Thumbnail(s)
   
Antworten Top
#5
Hallo,
nach dem du mir nun verraten hast, was du eigentlich willst (ich nahm an, nur Beispiele, wie man das macht!), hier ein Angebot:
Code:
Option Explicit 'damit wird das Vereinbaren von Variablen erzwungen

Sub übertragen()
Dim i As Long, Eingabe As Object, Dienst As Object, spalte
  Set Eingabe = Sheets("Eingabe") 'Objekte für die Blätter
  Set Dienst = Sheets("Dienst")
  With Eingabe
    i = LetztenWertFinden(Eingabe, 6, 3) 'letzte belegte Zeile in Spalte 6
    .Range(.Cells(3, 6), .Cells(i, 6)).Copy 'man muss nicht vorher selektieren
  End With
  With Dienst
    .Activate 'Blatt anzeigen
    Set spalte = .Rows(1).Find(what:=Eingabe.Cells(3, 2), lookat:=xlWhole)
    'finden der Spalte mit der Fahrernummer
    If spalte Is Nothing Then 'kann eigentlich nicht sein, trotzdem!
      MsgBox "Fahrernummer nicht vorhanden"
      Exit Sub
    End If
    i = LetztenWertFinden(Dienst, spalte.Column, 1) 'letzte belegte Zeile in Dienst in Spalte mit Fahrernr
      .Cells(i + 1, spalte.Column).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False
    .Cells(i + 1, spalte.Column).Select 'hier darf man mal
  End With
End Sub
Function LetztenWertFinden(Blatt, spalte, start)
'sucht letzten nichtleeren EIntrag in Object Blatt, Spalte spalte ab Zeile start
Dim zeile As Long
  zeile = start
  While Blatt.Cells(zeile, spalte) <> ""
    zeile = zeile + 1
  Wend
  LetztenWertFinden = zeile - 1
End Function
Das LetztenWertFinden braucht es, da du/ihr in den Spalten bis 8000 schon irgendwann irgendwas eingetragen hattet und somit die Zellen nich "jungräulich" sind und End(xlUp) dann falsche Werte liefert.
Und bei im Forum veröffentlichten Dateien sollten Passwörter (Dienstplan) nicht vorhanden sein...
Gruß der AlteDresdner (Win11, Off2021)
[-] Folgende(r) 1 Nutzer sagt Danke an AlterDresdner für diesen Beitrag:
  • Cassiopeia1980
Antworten Top
#6
Sorry, ich dachte ich hätte alles entsperrt Blush . Das Passwort ist 1980

Das kommt davon wenn man mehrere Sachen gleichzeitig macht. Ich dachte auch ich hätte verständlich rübergebracht was ich wollte, ich werde mich bessern und das nächste mal wieder wenn ich ruhe habe meine Frage stellen.

Der Code klappt perfekt, vielen Dank. Mir war nicht klar das es einen unterschied zwischen einer jungfräulichen und einer leeren schon benutzten Zelle gibt, wieder was dazu gelernt. Mit dem Rest werde ich mich die Tage versuchen auseinander zu setzten, Danke für die Randnotizen das macht es mir etwas leichter es zu verstehen.

Gruß
[-] Folgende(r) 1 Nutzer sagt Danke an Cassiopeia1980 für diesen Beitrag:
  • AlterDresdner
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste