Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
944to948
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
944to948
944to948
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Tabellenblätter automatisch erstellen und ausfülle

Tabellenblätter automatisch erstellen und ausfülle
24.01.2008 14:27:42
Daniel
Hallo Forum,
ich habe hier eine Mappe in der ich eine Vorlage für den Aussendienst hab.
Leider brauch ich pro Kunden ein Tabellenblatt und daher würde ich diese gerne automatisch erstellen.
Es gibt noch ein weiteres Problem, und zwar soll in den neu erstellten Blättern auch gleich in der Zelle A2 die Kundennummer eingetragen werden.
Weiteres wäre es angebracht wenn das Tebellenblatt gleich den Namen bekommt, der im Blatt mit den Nummern hinter der Nummer steht.
Quasi, Formel für dumme, bitte nicht lachen :)
erstelle neues Blatt, name des blattes steht in kundennummern!b1, wenn du das neue Blatt erstellt hast, dann füge bei diesem den Wert der in kundennummern!a1 steht bei A2, ein.
und das ganze bis er alle zeilen in "kundennummern" durch hat...
zur Info
VBA makros kann ich einsetzen, auch ein bischen abändern ist kein Problem, damit ihr wisst wie ihr bei mir dran seid :)
vielen Dank
Daniel

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellenblätter automatisch erstellen und ausf
24.01.2008 15:39:24
Erich
Hallo Daniel,
probier mal

Option Explicit
Sub Kundenblaetter_anlegen()
Dim rngMuster As Range, zz As Long, ss As Long
Set rngMuster = Sheets("Tabelle1").Columns("A:J")
With Sheets("kundennummern")
For zz = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
For ss = 1 To Sheets.Count
If Sheets(ss).Name = CStr(.Cells(zz, 1)) Then
MsgBox "Blatt '" & .Cells(zz, 1) & "' bereits vorhanden.", vbInformation
Exit For
End If
Next ss
If ss > Sheets.Count Then
Worksheets.Add after:=Sheets(Sheets.Count)
rngMuster.Copy Cells(1, 1)
Cells(2, 1) = .Cells(zz, 1)
ActiveSheet.Name = CStr(Cells(2, 1))
End If
Next zz
End With
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: Tabellenblätter automatisch erstellen und ausf
24.01.2008 16:18:00
Erich
Hallo Daniel,
hier noch eine Variante mit Beschleuniger:

Option Explicit
Sub Kundenblaetter_anlegen()
Dim rngMuster As Range, calcOld As XlCalculation, zz As Long, ss As Long
Dim Calc As XlCalculation
Calc = Application.Calculation: Beschleuniger xlCalculationManual
Set rngMuster = Sheets("Tabelle1").Columns("A:J")
With Sheets("kundennummern")
For zz = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
For ss = 1 To Sheets.Count
If Sheets(ss).Name = CStr(.Cells(zz, 1)) Then
MsgBox "Blatt '" & .Cells(zz, 1) & "' bereits vorhanden.", vbInformation
Exit For
End If
Next ss
If ss > Sheets.Count Then
Worksheets.Add after:=Sheets(Sheets.Count)
rngMuster.Copy Cells(1, 1)
Cells(2, 1) = .Cells(zz, 1)
ActiveSheet.Name = CStr(Cells(2, 1))
End If
Next zz
End With
Beschleuniger Calc
End Sub
'   Beschleuniger _______ Parameter: Calc-Status ______ gi/12.03.2006
'        Aufruf:
'           Dim Calc As XlCalculation
'           Calc = Application.Calculation: Beschleuniger xlCalculationManual
'           ....Code....
'           Beschleuniger Calc
Sub Beschleuniger(Optional StatCal As Long = xlCalculationAutomatic)
With Application
.Calculation = StatCal
.ScreenUpdating = (StatCal  xlCalculationManual)
.EnableEvents = (StatCal  xlCalculationManual)
End With
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: Tabellenblätter automatisch erstellen und ausf
25.01.2008 13:56:00
Daniel
Hallo Erich,
ich habe deine Variante mit Beschleuniger getestet, er hat alle Blätter einwandfrei erstellt.
NUR wenn ich jetzt in den Blättern Änderungen vornehme und mit der ENTER bestätige, dann bekomme ich die Meldung "Projekt oder Bibliothek nicht gefunden".
Was kann das sein?
vielen Dank
mfg

AW: Tabellenblätter automatisch erstellen und ausf
25.01.2008 14:10:00
Erich
Hallo Daniel,
laufen da irgendwelche Ereignismakros (evtl. im Modul "DieseArbeitsmappe)?
Eine einfache Dateneingabe dürfte sonst nicht eine derartige Reaktion hervorrufen.
Oder verwendest du bei der Eingabe eine benutzerdefinierte VBA-Funktion?
Wenn du die Meldung "Projekt oder Bibliothek nicht gefunden" siehst,
wurde dann der VBA-Editor geöffnet?
Kannst du bei der Fehlermeldung auf "Debuggen" klicken?
Wird ein Modul angezeigt? Ist eine Zeile markiert? Das wäre dann die Zeile mit dem Fehler.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: Tabellenblätter automatisch erstellen und ausf
25.01.2008 14:13:00
Daniel
Hallo Erich,
vielen Dank erstmal für deine Antwort,
hab die Datei jetzt auf einen Anderen Rechner kopiert...da wo sie eigentlich hin soll und da kommt der fehler nicht.
Daher schieb ichs jetzt mal auf meinen Rechner und da ich schon fast fertig bin damit will ich mich nicht mehr aufhalten, warscheinlich ein Problem durch meine Excel XP, update 2003, beta 2007, wieder zurück auf 2003 installation.
Vielen Dank aber trotzdem.
mfG

AW: Tabellenblätter automatisch erstellen und ausfülle
24.01.2008 15:49:00
michael
Hi Daniel
Anbei ein Muster-das Makro stammt aus dem Forum (gez.Sepp)
einfach nur Makro starten.
aha garantiert !!
lg michael

Sub DreiEinfügen()
Dim Zelle As Range
On Error GoTo ErrExit
GetMoreSpeed
For Each Zelle In ThisWorkbook.Sheets("Liste").Range("A1:A" & ThisWorkbook.Sheets("Liste"). _
Cells(Rows.Count, 1).End(xlUp).Row)
ThisWorkbook.Sheets("Muster").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) _
With ActiveSheet
.Name = Zelle.Value
.Cells(2, 1) = Zelle.Value
.Cells(1, 2).Value = Zelle.Offset(0, 1).Value
End With
Next
ErrExit:
GetMoreSpeed 0
End Sub



Sub GetMoreSpeed(Optional ByVal Modus As Integer = 1)
Static lngCalc As Long
With Application
If Modus = 1 Then
lngCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = -4135
.Cursor = xlWait
Else
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = IIf(lngCalc  0, lngCalc, -4105)
.Cursor = xlDefault
End If
End With
End Sub


https://www.herber.de/bbs/user/49338.xls
Deine Datei als Muster .
'Dieses Makro ist aus dem Forum von---- Sepp----

Anzeige
AW: Tabellenblätter automatisch erstellen und ausf
24.01.2008 16:17:37
Daniel
Danke an euch beide, habs hinbekommen.
Das IST einfach die erste Anlaufstelle für Excel Probleme, weiter so !!!
mfg

140 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige