Tabellen rechts einfügen

Sub Blaetter_erzeugen() Dim wksBlatt As Worksheet Dim i As Integer Dim x As Integer For i = 1 To 31 Set wksBlatt = Sheets.Add wksBlatt.Name = (i) Set wksBlatt = Sheets.Add x = (i) - 1 wksBlatt.Name = (i) & "-" & x Next i End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Blaetter2_erzeugen() Dim c As Integer Dim i As Integer Dim x As Integer ThisWorkbook.Activate For i = 1 To 31 c = Worksheets.Count Worksheets.Add After:=Worksheets(c) ActiveSheet.Name = (i) Worksheets.Add x = (i) - 1 ActiveSheet.Name = (i) & "-" & x Next i End Sub

Sub Blaetter2_erzeugen() Dim c As Integer Dim i As Integer Dim x As Integer ThisWorkbook.Activate For i = 1 To 31 c = Worksheets.Count x = (i) + 1 If x > 31 Then Worksheets.Add After:=Worksheets(c) ActiveSheet.Name = (i) Exit Sub End If Worksheets.Add After:=Worksheets(c) ActiveSheet.Name = (i) & "-" & x Worksheets.Add ActiveSheet.Name = (i) Next i End Sub

Sub MonatsendeTesten() ThisWorkbook.Worksheets("tabelle2").Activate Range("D3").Value = Monatsende(Range("D1").Value, Range("D2").Value) End Sub Function Monatsende(J As Integer, M As Integer) As Integer If M = 2 Then If J Mod 4 = 0 And J Mod 100 0 Or J Mod 400 = 0 Then Monatsende = 29 Else Monatsende = 28 End If ElseIf M = 4 Or M = 6 Or M = 9 Or M = 11 Then Monatsende = 30 Else Monatsende = 31 End If End Function

Public Sub Create_File_and_Sheets(Month As String)' Month wird beim Aufruf der Sub geliefert Dim test As Object Dim i As Double Dim xls As Object Dim c As Integer Dim x As Integer Set test = CreateObject("Excel.Application") test.Visible = False Set xls = test.Workbooks.Add xls.SaveAs App.Path & "\tt.xls" ' Hier müßte z.B. April.xls stehen For i = 1 To 31 'Hier werden die Anzahl Sheets nach Anzahl der Tage des Monats c = Worksheets.Count x = (i) + 1 If x > 31 Then Worksheets.Add After:=Worksheets(c) ActiveSheet.Name = (i) Exit Sub End If Worksheets.Add After:=Worksheets(c) ActiveSheet.Name = (i) & "-" & x Worksheets.Add ActiveSheet.Name = (i) Next i xls.Save test.Quit Set xls = Nothing End Sub

Hallo Mike
Ich habs jetzt so gemacht.

Public Sub Create_File_and_Sheets(Monat As String, Days As Integer)
Dim test As Object
Dim i As Double
Dim xls As Object
Dim c As Integer
Dim x As Integer
Set test = CreateObject("Excel.Application")
test.Visible = False
Set xls = test.Workbooks.Add
xls.SaveAs App.Path & Monat & ".xls"   'Hier ist mein Problem1.In der Var. Monat steht der  _
Name
For i = 1 To Days
c = Worksheets.Count
x = (i) + 1
If x > 31 Then
Worksheets.Add After:=Worksheets(c)
ActiveSheet.Name = (i)
Exit Sub
End If
Worksheets.Add After:=Worksheets(c)
ActiveSheet.Name = (i) & "-" & x
Worksheets.Add
ActiveSheet.Name = (i)
'xls.Save                             'Problem 2
Set xls = Nothing
Next i
test.Quit
End Sub

Ich habe aber leider noch 2 Probleme.
1.) Die Excel-Dateien werden auf dem Desktop und nicht in den Ordner Excel, auf dem Desktop, angelegt.
Aber die Datei heißt dann "ExcelJanuar"
2.) Es werden zuviele Instanzen von Excel geöffnet. Nach erzeugen von der Januar-Datei, motz er und sagt er kann kein Blatt mit gleichem Namen erzeugen. aber er sieht nicht das er schon im Feb. ist.
Wann und wo muß ich die erste Instanz, also Januar, schliessen.
Wenn du es brauchst schicke ich Dir das ganze Programm.
Gruß

Option Explicit Sub Blaetter_erzeugen() Dim wksBlatt As Worksheet Dim i As Integer Dim x As Integer For i = 31 To 2 Step -1 Set wksBlatt = Sheets.Add wksBlatt.Name = i Set wksBlatt = Sheets.Add x = i - 1 wksBlatt.Name = x & "-" & i Next i End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread