Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 12:58:59
Daten einfügen aus anderem Sheet
19.04.2024 12:23:24
Wenn-Formel anpassen
19.04.2024 12:09:19
Unique (Application.WorksheetFunction.Unique)
19.04.2024 11:51:37
Nächsten identischen Treffer suchen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1656to1660
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1656to1660
1656to1660
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Excel teilen

Excel teilen
14.11.2018 12:57:53
Eppler
Guten Tag
Da ich keine Ahnung habe kann ich mir die Schnipsel nicht zusammen bauen.
Ich suche ein Makro das mir in einem Excel ein Tabellen Blatt splittet.
Ich möchte eingeben wie gross diese teilen soll danach soll es die Teile neu abspeichern und das Original soll erhalten bleiben und die Überschrift muss in jedem zuoberst stehen.
Als Beispiel mein Datenblatt hat 130 einträge und dieses soll gesplitett werden ich wähler als Beispiel 50 dann soll es drei neue Excel files geben und das Orginal soll bestehen bleiben.
Wer könnte mir da helfen?
Besten Dank

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Beispielmappe bitte. o.W.T.
14.11.2018 13:22:40
Werner
AW: Excel teilen
14.11.2018 13:27:52
Rudi
Hallo,
wenn es nur um Daten geht: 
Sub TeilMich()
Dim iCounter As Integer, vntAnz, vntHeader, vntData, wkb As Workbook, wks As Worksheet
Set wks = ActiveSheet
Application.ScreenUpdating = False
vntAnz = Application.InputBox("Anzahl Zeilen?")
If VarType(vntAnz) = vbBoolean Then
Exit Sub
Else
With wks.Cells(1, 1).CurrentRegion
vntHeader = .Rows(1)
For iCounter = 1 To (.Rows.Count - 1) / anz
vntData = .Rows((iCounter - 1) * vntAnz + 2).Resize(vntAnz)
Set wkb = Workbooks.Add(1)
wkb.Sheets(1).Cells(1, 1).Resize(, UBound(vntHeader, 2)) = vntHeader
wkb.Sheets(1).Cells(2, 1).Resize(vntAnz, UBound(vntData, 2)) = vntData
wkb.SaveAs ThisWorkbook.Path _
& "\" & wks.Name & "_" _
& Format(iCounter, "000"), xlOpenXMLWorkbook
wkb.Close
Next iCounter
End With
End If
End Sub

Gruß
Rudi
Anzeige
da ich jetzt auch schon....
14.11.2018 15:00:23
Werner
Hallo,
...was gebastelt habe: 
Option Explicit
Public Sub Splitten()
Dim loLetzte As Long, i As Long, loZähler As Long
Dim loSpalte As Long, vaAnzahl As Variant
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
loZähler = 1
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Column
vaAnzahl = Application.InputBox("Splitten in Zeile xx", "Zeilenzahl", , , , , , 1)
If vaAnzahl = False Then Exit Sub
For i = 2 To loLetzte Step vaAnzahl
.Range(.Cells(1, 1), .Cells(1, loSpalte)).Copy Worksheets("Tabelle2").Range("A1")
.Range(.Cells(i, 1), .Cells(i, loSpalte)).Resize(vaAnzahl).Copy _
Worksheets("Tabelle2").Range("A2")
Worksheets("Tabelle2").Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\DerDateiname_" _
& Format(loZähler, "000") & ".xlsx"
ActiveWorkbook.Close
Worksheets("Tabelle2").Cells.ClearContents
loZähler = loZähler + 1
Next i
End With
End Sub
@Rudi:
Schreibfehler 
For iCounter = 1 To (.Rows.Count - 1) / anz

statt 
For iCounter = 1 To (.Rows.Count - 1) / vntAnz
Gruß Werner
Anzeige

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige