Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
280to284
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
280to284
280to284
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Aus einer Arbeitsmappe 62 machen??

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
Anzeige
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


Anzeige
AW: super Funkt
19.07.2003 21:38:07
Ivan
hi Ramses
Vielen dank du hast mir eine menge arbeit erspart!!

gruss aus Wien
ivan


Korrektur
19.07.2003 21:46:43
Ramses
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


Anzeige
AW: Korrektur
19.07.2003 21:59:18
Ivan
Hi Rainer
Danke jetzt brauch ich nicht kopieren.:))lol

gruss
ivan


300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige