Dreimal einfügen plus Kopieren-

Forumthread: Dreimal einfügen plus Kopieren-

27.01.2007 15:01:17

michael

Herzliche Grüße ins Forum


Sub DreimalEinfügen()
Dim Zelle As Range
For Each Zelle In Sheets("Tabelle1").Range("A1:A9")Verküzt auf 9 TabBätter
ThisWorkbook.Sheets.Add after:=Sheets(ThisWorkbook.Sheets.Count)
With ActiveSheet
.Name = Zelle.Value
.Cells(1, 1) = Zelle.Value
.Cells(1, 2).Value = Zelle.Offset(0, 1).Value
End With
Next
End Sub

Mit diesem Makro (Danke ans Forum) füge Ich 56 Tab.ein und Beschrifte sie lt.Spalte A und B.
Alle einzufügenden Tab.sehen gleich aus und haben (bis auf den Text) den selben Aufbau.
Siehe bitte Beigefügte Datei..1 ist Liste 4 ist Muster.
Jetzt meine bitte :
A:/..Könnt ihr mir in obiges Makro ( Das Kopieren und Einfügen? ) der Muster Tab.
einfügen.
B:/..Oder ich lege alle Tab. an (Sage Alle Tab Markieren Kopiere und Füge ein)
danach sehen alle Tab. gleich aus nur die Beschriftung ist weg-.
in diesem Fall (vom Makro her wahrscheinlich der einfachere Weg)
obiges Makro bitte so einkürzen ? das es nur mehr die Beschriftung
A1 und B1 kann.
Vielen Dank für eure Hilfe
michael
https://www.herber.de/bbs/user/39965.xls

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Dreimal einfügen plus Kopieren-

27.01.2007 15:46:33

Josef
AW: Dreimal einfügen wooooh-mit Text

27.01.2007 16:42:46

michael

AW: Dreimal einfügen plus Kopieren-

27.01.2007 15:46:33

Josef

Hallo Michael,
so wird "Muster" kopiert.
Sub DreimalEinfü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(1, 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

Gruß Sepp

AW: Dreimal einfügen wooooh-mit Text

27.01.2007 16:42:46

michael

Hallo Sepp
Vielen Dank - mir ist der Mund offen stehengeblieben
der Speed allein ist eine Sensation.
Nochmals vielen lieben Dank und ein schönes Wochenend.
michael

Beliebteste Forumthreads (12 Monate)

Forumthread: Dreimal einfügen plus Kopieren-

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread