Arbeitsmappe/Tabellenblatt automatisch duplizieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Jo,
das kannst Du ganz einfach über den Makro-Recorder lösen und anschliessend das Makro in Deine Hauptdatei einbauen. Anschliessend kannst Du es so einbauen, dass es zum Beispiel ausgeführt wird sobald die Hauptdatei geschlossen wird.
Am besten Du schaust Dir als erstes einmal den Makro-Recorder an. Der kann schon eine ganze Menge ohne viel Programmierung.
Ein Makro könnte am Ende z.B. so in der Art aussehen - natürlich passen da noch Deine Druckeinstellungen usw. noch nicht wie Du es brauchst.

Sub Kopie()
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.787401575)
.BottomMargin = Application.InchesToPoints(0.787401575)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA3
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
ActiveWorkbook.SaveAs Filename:="C:\My Documents\KopieA3.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
End Sub

VG
Marco

'Code unter DieseArbeitsmappe der A4-Datei Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim strName As String Dim wkbCopy As Workbook, wks1 As Worksheet strName = Replace(Me.FullName, ".xls", "A3.xls") 'Name der A3-Datei - ggf. anpassen If Not InStr(Me.Name, "A3.xls") > 0 Then 'Prüfung ggf. anpassen Application.EnableEvents = False Me.SaveCopyAs strName Set wkbCopy = Application.Workbooks.Open(Filename:=strName) Set wks1 = wkbCopy.Worksheets(1) With wks1 With .PageSetup .PaperSize = xlPaperA3 .Orientation = xlLandscape 'Querformat End With End With wkbCopy.Close savechanges:=True Application.EnableEvents = True End If End Sub

'Code unter DieseArbeitsmappe der A4-Datei Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim strName As String Dim wkbCopy As Workbook, wks1 As Worksheet, rngCopy As Range 'Name der Datei mit Blatt im A3+-Format strName = Replace(Me.FullName, ".xls", "A3.xls") 'Pfad\Name der A3-Datei - ggf. anpassen 'Prüfung, damit Kopiervorgang nur ausgeführt wir, wenn die A4-Datei geschlossen wird If Not LCase(Me.Name) = LCase(Mid(strName, InStrRev(strName, "\"))) Then 'Prüfung ggf. _ anpassen Application.EnableEvents = False 'zu kopierenden Zellbereich mit verwendeten Zellen im A4-Datei setzen Set rngCopy = Me.Worksheets(1).UsedRange 'Datei im A3+-Format öffnen Set wkbCopy = Application.Workbooks.Open(Filename:=strName, addtomru:=True) With wkbCopy.Worksheets(1) 'vorhandene Inhalte in A3+-Datei löschen .UsedRange.Clear 'Daten aus A4-Dastei nach A3+-Datei kopierenn rngCopy.Copy Destination:=.Range(rngCopy.Range("A1").Address) End With Application.CutCopyMode = False wkbCopy.Close savechanges:=True Application.EnableEvents = True End If End Sub

'Code unter DieseArbeitsmappe der A4-Datei Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim strName As String Dim wkbCopy As Workbook, wks1 As Worksheet strName = Replace(Me.FullName, ".xls", "Spielplan A3+.xls") 'Name der A3-Datei - ggf. _ anpassen If Not InStr(Me.Name, "Spielplan A3+.xls") > 0 Then 'Prüfung ggf. anpassen Application.EnableEvents = False Me.SaveCopyAs strName Set wkbCopy = Application.Workbooks.Open(Filename:=strName) Set wks1 = wkbCopy.Worksheets(1) With wks1 With .PageSetup .PaperSize = 140 'FSLE .Orientation = xlLandscape 'Querformat End With End With wkbCopy.Close savechanges:=True Application.EnableEvents = True End If End Sub

Hallo Franz,
das mit dem VBA - Diese Arbeitsmappe habe ich schon verstanden.
Womit ich nichts anfangen kann, ist Papersize im Makro ist 140 auf meinem System für FSLE in der Seiten-Layout-Einstellung.
Was bedeutet die 140 und was ist FSLE und wann schalte ich den Makro-Rekorder ein?
Kannst du mir das bitte verständlich machen.
Ich hätte da noch eine Frage.
Besteht eine Möglichkeit, in folgendem Tabellenblatt (von dem es mehrere für die Jahre 2016 usw. gibt)
https://www.herber.de/bbs/user/130624.xlsx
Ich möchte gerne, dass ich ab einen gewissen Datum die Spalten z.B. M-Q auslesen kann wie oft zum Beispiel "Gels G." eben ab dem gewissen Datum vorkommt. Habe es mit Zählenwenn oder auch Zählenwenns versucht kam aber nicht mehr weiter.
Gruß Jo

Blattname Turnier 2016 Turnier 2017 Turnier 2018 Turnier 2019 Name Datum >= Gesamt Anzahl Anzahl Anzahl Anzahl Gels G. 01.07.2018 3 0 0 3 0 Formeln: C3: =SUMME(D3:G3) D3: =WENNFEHLER(SUMMENPRODUKT((INDIREKT("'" & D$1 &"'!B6:$B$500")>=$B3)*((INDIREKT("'" & D$1 &"'!$M$6:$M$500")=$A3)+(INDIREKT("'" & D$1 &"'!$N$6:$N$500")=$A3)+(INDIREKT("'" & D$1 &"'!$O$6:$O$500")=$A3)+(INDIREKT("'" & D$1 &"'!$P$6:$P$500")=$A3)+(INDIREKT("'" & D$1 &"'!$Q$6:$Q$500")=$A3)));0)

Beliebteste Forumthreads (12 Monate)

Arbeitsmappe/Tabellenblatt automatisch duplizieren

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread