Schleifenfehler
Tobias
Also ich habe eine schleife in meinem makro, welche ein tabellenblatt in eine neue arbeitsmappe kopiert und in das blatt soll dann ein makro geschrieben werden. Ab dem zweiten Blatt funktioniert das auch reibungslos.
Nur beim ersten vergisst er es. mache ich aber vor dem ausführen des makros VBA auf und drücke dann wieder den Knopf zum ausführen, ohne irgendwas im Makro zu machen, dann funktioniert es. wie kommt das?
Hier mein Code
Dim iTemp As Integer
Dim oBook As Workbook
Dim Auswertung As Integer
Application.ScreenUpdating = False
' Create a new blank workbook:
iTemp = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set oBook = Application.Workbooks.Add
Application.SheetsInNewWorkbook = iTemp
' Add a defined name to the workbook
' that RefersTo a range:
oBook.Names.Add Name:="tempRange", _
RefersTo:="=Sheet1!$A$1"
' Save the workbook:
oBook.SaveAs (ThisWorkbook.Path & "\" & "Auswertung " & "MTC_" & ThisWorkbook.Worksheets("MasterTabelle - Modulauswertung").Cells(4, 4) & ".xls")
ThisWorkbook.Worksheets(Array("MasterTabelle - Modulauswertung", "Zusammenfassung")).Copy After:=oBook.Worksheets(Worksheets.Count)
' Copy the sheet in a loop. Eventually,
' you get error 1004: Copy Method of
' Worksheet class failed.
For Auswertung = 45 To 74
If ThisWorkbook.Worksheets("MasterTabelle - Modulauswertung").Cells(Auswertung, 2) = "" Then 'wenn letzte Seriennummer erreicht
GoTo Transport
End If
ThisWorkbook.Worksheets("1").Copy After:=oBook.Worksheets(Worksheets.Count)
Dim sCode As String
sCode = "'Tabellennamen umbenennen" & vbCrLf & _
"
Private Sub Worksheet_Activate()" & vbCrLf & _
vbTab & "ActiveSheet.Name = ActiveSheet.Range(""B3"").Text" & vbCrLf & _
"End Sub
ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.VBProject.VBComponents.Count).CodeModule.AddFromString sCode
ActiveWorkbook.Save
With ActiveSheet
.Range("B3").Formula = _
"=" & "'MasterTabelle - Modulauswertung'!" & .Cells(Auswertung, 2).Address(0, 0)
End With
With ActiveSheet
.Range("B2").Formula = _
"=" & "'MasterTabelle - Modulauswertung'!" & .Cells(4, 4).Address(0, 0)
End With
With ActiveSheet
.Range("H2").Formula = _
"=" & "'MasterTabelle - Modulauswertung'!" & .Cells(Auswertung, 6).Address(0, 0)
End With
With ActiveSheet
.Range("B110:M110").Copy
End With
BlattX = Auswertung - 36
Sheets("Zusammenfassung").Select
Sheets("Zusammenfassung").Range("D" & CStr(BlattX)).Select
ActiveSheet.Paste Link:=True
'Uncomment this code for the workaround:
'Save, close, and reopen after every 15 iterations:
If Auswertung Mod 15 = 0 Then
oBook.Close SaveChanges:=True
Set oBook = Nothing
Set oBook = Application.Workbooks.Open(ThisWorkbook.Path & "\" & "Auswertung " & "MTC_" & ThisWorkbook.Worksheets("MasterTabelle - Modulauswertung").Cells(4, 4) & ".xls")
End If
Next
Hoffe ihr könnt mir helfen