Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1320to1324
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Wie geht das schneller

VBA: Wie geht das schneller
05.07.2013 19:57:11
Raphael
Hallo zusammen,
ich nutze Momentan den unten angefügten Code um ein Tabellenblatt zu kopieren und dies unter einem Namen welcher in einer Zelle steht einzufügen.
Der Code ist allerdings sehr langsam, da er jedes Blatt anwählt um den Namen zu vergeben. Gibt es hier einen schnelleren und/oder besseren Ansatz?
Ich muss jedes Mal knapp 100 Blätter erstellen, dauert also ein Weilchen.
Sub Alle_Blätter_gem_Wohnen_1_erstellen()
Dim Kojen_Namen As Range
Dim Zelle As Variant
Set Kojen_Namen = Worksheets("Status").Range("C6:C114")
For Each Zelle In Kojen_Namen
On Error Resume Next
i = Sheets.Count
Worksheets("Wohnen 1").Copy After:=Sheets(i)
ActiveSheet.Name = Zelle.Value
Worksheets(Zelle.Value).Range("F1") = Zelle.Value
Next
End Sub
Besten Dank für eure Hilfe.
Gruess
Raphael

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: Wie geht das schneller
06.07.2013 06:42:34
Martin
Hallo Raphael,
dein Code ist schon recht effizient und aus meiner Sicht nicht optimierbar. Du kannst lediglich die Bildschirm-Aktualisierung und Automatische Berechnung vorübergehend deaktivieren, das bringt sicherlich einen deutlichen Performance-Schub.

Sub Alle_Blätter_gem_Wohnen_1_erstellen()
Dim Kojen_Namen As Range
Dim Zelle As Variant
Set Kojen_Namen = Worksheets("Status").Range("C6:C114")
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
For Each Zelle In Kojen_Namen
On Error Resume Next
i = Sheets.Count
Worksheets("Wohnen 1").Copy After:=Sheets(i)
ActiveSheet.Name = Zelle.Value
Worksheets(Zelle.Value).Range("F1") = Zelle.Value
Next
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Viele Grüße
Martin

Anzeige
AW: VBA: Wie geht das schneller
06.07.2013 10:49:18
Matze
Hallo Raphael,
das berechnen dauert ja ne weile bis er die For Schleife durchlaufen hat,
hier eine etwas andere Schreibweise ohne die Variablen Kojen_Name und i
Sub kopieren()
Dim rngC As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each rngC In Sheets("Status").Range("C6:C114")
If rngC  "" Then
Sheets("Wohnen 1").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = rngC
.Range("F1") = rngC
End With
End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Anzeige
...wenn schon denn schon...
06.07.2013 19:26:48
Martin
Hallo Matze,
noch besser ist...
Sub Alle_Blätter_gem_Wohnen_1_erstellen()
Dim rngC As Range
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
For Each rngC In Sheets("Status").Range("C6:C114")
If rngC  "" Then
Sheets("Wohnen 1").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = rngC
.Range("F1") = rngC
End With
End If
Next
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Viele Grüße
Martin

AW: ...wenn schon denn schon...
07.07.2013 00:37:20
Raphael
Hallo Martin, Hallo Matze,
besten Dank für Eure Hilfe, der Code ist jetzt um vieles schneller als vorher. Ich habe zu Euren Versionen nochmals einen kleinen kniff gefunden die Performance zu steigern.
Wenn man den Sheets.Count nur einmal vor der eigentlichen Schleife macht und danach immer +1 zählen lässt spart man nochmals einige Sekunden.
Sub Alle_Blätter_gem_Wohnen_1_erstellen()
Dim Zelle As Range
Dim i As Integer
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
i = Sheets.Count
For Each Zelle In Worksheets("Status").Range("C6:C114")
If Zelle  "" Then
Worksheets("Wohnen 1").Copy After:=Sheets(i)
With ActiveSheet
.Name = Zelle
.Range("F1") = Zelle
End With
i = i + 1
End If
Next
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub
Nochmals besten Dank
Gruess
Raphael
Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige