automatisch neues Tabellenblatt + Daten kopieren

[Frogger1986]

Ich grenze über den sheet.count ( Anzahl der Tabellenblätter) den Bereich für die Funktion Finden ein und mit jedem neuen Tabellenblatt rutscht das Makro um eine Zeile weiter um die Daten zu übertragen! D.h. sollten z.b. 5 Blätter vorhanden sein fängt er nicht in der zeile 10 an, sondern in der zeile 15 d.h. sollten neue Daten in den Zeilen stehen werden diese nicht berücksichtigt. Aber sollte das stören, könnte ich das noch umschreiben! Was ich nur nicht verstehe warum erst die Tabellenblätter erstellt werden zum Drucken und nicht gleich gedruckt wird?!

[Flyto]

Danke für die Erklärung! Ich wollte noch ein Blatt mit einer Erklärung hinzufügen also eine Art Anleitung aber ich schau mal ob ich das anders löse oder selber rauskriege - will nicht dass du dir umstände machst! :) Aber wenn ich gar nicht weiterkomme melde ich mich nochmal :D

Grund ist folgender: Es geht um Änderungen der Mitarbeiter, die Personen tragen das in der Excel ein in der Liste und die "Aufträge" müssen abgearbeitet werden. Dafür braucht man jeden "Auftrag" also jede Person separat ausgegeben damit man jeden separat drucken kann. Es macht jedoch keinen Sinn die Eingabe separat zu machen. Deshalb die Eingabe in der Liste und die Ausgabe dann in den Tabellen. Wenn man es so ausdrucken würde, wäre es ja nur die Liste untereinander :) 

Vielen vielen Dank!

[Frogger1986]

Man könnte anstatt immer eine neue Vorlage anzulegen, einfach eine mit den Daten füllen, das ausdrucken, dann mit den nächsten Daten füllen dann wieder drucken usw.. So wird alles im Format deiner Vorlage gedruckt ohne tausend Tabellenblätter anzulegen..... Das drucken würde dann auch das Makro übernehmen!

[Flyto]

Ach krass sowas geht auch? Ist ja ein Ding. Wie macht man das dann? Das wäre natürlich eine deutliche Erleichterung, dann muss man die Blätter nicht immer löschen :D

[Flyto]

Hab mir diese Lösung zusammengebastelt. Danke für den Tipp! Das funktioniert jetzt auch soweit :) Gibt es vermutlich noch eine elegantere Lösung aber es funktioniert ja.

Danke dir für deine Hilfe - bin dir sehr dankbar!

Code:

Private Sub Drucken_Click()
For Each NeueTabelle In Worksheets("Antrag").Range("F10:F30").Value
  If Not IsEmpty(NeueTabelle) Then
          Sheets("Vorlage").Copy After:=Sheets(Sheets.Count)
          Application.DisplayAlerts = False
              On Error Resume Next: Sheets(NeueTabelle).Delete: On Error GoTo 0
              Application.DisplayAlerts = True
          Sheets(Sheets.Count).Name = NeueTabelle
         
              Bereich = Sheets.Count
              Bereich = Bereich + 7
             
              Set finden = ThisWorkbook.Sheets("Antrag").Range("F" & Bereich & ":" & "F30").Find(NeueTabelle)
              Zeile = finden.Row
              ActiveSheet.Cells(2, 3).Value = Sheets("Antrag").Cells(Zeile, 2).Value
              ActiveSheet.Cells(3, 3).Value = Sheets("Antrag").Cells(Zeile, 3).Value
              ActiveSheet.Cells(6, 3).Value = Sheets("Antrag").Cells(Zeile, 4).Value
              ActiveSheet.Cells(7, 3).Value = Sheets("Antrag").Cells(Zeile, 5).Value
              ActiveSheet.Cells(8, 3).Value = Sheets("Antrag").Cells(Zeile, 6).Value
              ActiveSheet.Cells(9, 3).Value = Sheets("Antrag").Cells(Zeile, 7).Value
              ActiveSheet.Cells(10, 3).Value = Sheets("Antrag").Cells(Zeile, 8).Value
              ActiveSheet.Cells(11, 3).Value = Sheets("Antrag").Cells(Zeile, 9).Value
              ActiveSheet.Cells(12, 3).Value = Sheets("Antrag").Cells(Zeile, 10).Value
              ActiveSheet.Cells(13, 3).Value = Sheets("Antrag").Cells(Zeile, 11).Value
              ActiveSheet.Cells(15, 3).Value = Sheets("Antrag").Cells(Zeile, 12).Value
              ActiveSheet.Cells(16, 3).Value = Sheets("Antrag").Cells(Zeile, 13).Value
              ActiveSheet.Cells(19, 3).Value = Sheets("Antrag").Cells(Zeile, 14).Value
              ActiveSheet.Cells(20, 3).Value = Sheets("Antrag").Cells(Zeile, 15).Value
             
              ActiveSheet.Range("A1:E22").Select
              Selection.PrintOut Copies:=1
             
             
            Application.DisplayAlerts = False
            ActiveSheet.Delete
            Application.DisplayAlerts = True
 
  End If
             
 Next
 
End Sub

[Frogger1986]

Brauchst du denn die ganzen Tabellenblätter? Sonnst würde ich das komplett weck lassen!

[Frogger1986]

Schau mal was ich noch gebastelt habe...

[Flyto]

Richtig super! Das ist jetzt ein ganz anderer Ansatz - werd mir das mal ansehen und versuchen zu verstehen.

Ich konnte das leider nicht früher hochladen, aber ich habe das ganze noch etwas erweitern müssen und versucht variabel zu gestalten, dass man die Wahl hat zwischen drucken und Ausgeben. Deinen Code könnte man für die Druckfunktion da sehr gut übernehmen! Ich werde das mal schauen ob ich das verbunden kriege und dann auch nochmal die Datei hier hochladen.
Ich habe gedanklich auch etwas weitergesponnen und mich gefragt ob es möglich ist, eine Spalte vorneran zu setzen mit einer Checbox und nur jene Zeilen zu exportieren/drucken/auszugeben welche markiert sind. Das würde man vermutlich über eine if abfrage regeln korrekt?

[Flyto]

Hab dein Druck-Makro da jetzt integriert - das ist schon mal wirklich top! Danke, da spart man sich den Umweg übers löschen.

[Frogger1986]

Hier mit Checkboxen.....