Aus einer Arbeitsmappe 62 machen??

Forumthread: Aus einer Arbeitsmappe 62 machen??

19.07.2003 14:47:22

Ivan

HALLO UND EIN SCHÖNES WOCHENENDE AN ALLE!

ich habe eine große arbeitsmappe die sehr lange zum öffnen braucht.
daher habe ich beschlossen diese mappe in 62 teile zu teilen.
es ist sehr mühsam dies manuelle zu machen.
zb.bereich a2-c1000 markieren alles kopieren,neue arbeitsmappe erstellen,
kopierten bereich einfügen,arbeitsmappe speichern unter.
und das mal 62.viel zu mühsam.

frage:
gibt es eine vba lösung wo ich aus der bestehenden mappe 62 arbeitsmappen erstellen kann??
es sollen jeweils 1000 zeilen in eine neue mappe kopiert werden der bereich ist A2:C62000

gruss
ivan

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Aus einer Arbeitsmappe 62 machen??

19.07.2003 21:30:22

Ramses
AW: super Funkt

19.07.2003 21:38:07

Ivan
Korrektur

19.07.2003 21:46:43

Ramses
AW: Korrektur

19.07.2003 21:59:18

Ivan

AW: Aus einer Arbeitsmappe 62 machen??

19.07.2003 21:30:22

Ramses

Hallo Ivan

probier mal das

Option Explicit

Sub Create_New_Workbooks()
'(C) Ramses
'Teiltden Bereich von 1 - 62000 in 1'000er Blöcke auf
'erstellt neue Mappen mit jeweils 1000 Zeilen
Dim i As Long, NewWks As Workbook
Set NewWks = Workbooks.Add
For i = 1 To 61
    Range(Cells(i * 1000, 1), Cells(i * 1000 - 1, 3)).Copy
    NewWks.ActiveSheet.Paste
    If i = 1 Then
        NewWks.SaveAs Filename:="Bereich " & i & " bis 999.xls"
    Else
        NewWks.SaveAs Filename:="Bereich " & i * 1000 & " bis " & (i + 1) * 1000 - 1 & ".xls"
    End If
    NewWks.Close
    Set NewWks = Nothing
    Set NewWks = Workbooks.Add
Next i
End Sub

Code eingefügt mit Syntaxhighlighter 1.16

Gruss Rainer

Hallo Ivan,

Tut mir leid, aber da ist ein Logikfehler drin gewesen :-(
Alle Dateien sind leer.

Nimm das Makro:

Option Explicit
Sub Create_New_Workbooks()
'(C) Ramses
'Teiltden Bereich von 1 - 62000 in 1'000er Blöcke auf
'erstellt neue Mappen mit jeweils 1000 Zeilen
Dim i As Long, NewWks As Workbook
For i = 1 To 61
    Set NewWks = Workbooks.Add
    If i = 1 Then
        Range(Cells(i, 1), Cells(i * 1000 - 1, 3)).Copy
        NewWks.Worksheets(1).Paste
        NewWks.SaveAs Filename:="Bereich " & i & " bis 999.xls"
    Else
        Range(Cells(i * 1000, 1), Cells((i + 1) * 1000 - 1, 3)).Copy
        NewWks.Worksheets(1).Paste
        NewWks.SaveAs Filename:="Bereich " & (i - 1) * 1000 & " bis " & (i + 1) * 1000 - 1 & ".xls"
    End If
    NewWks.Close
    Set NewWks = Nothing
Next i
End Sub

Code eingefügt mit Syntaxhighlighter 1.16

Gruss Rainer

Beliebteste Forumthreads (12 Monate)

Aus einer Arbeitsmappe 62 machen??

Forumthread: Aus einer Arbeitsmappe 62 machen??

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

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread