Excel teilen

Forumthread: 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

Beispielmappe bitte. o.W.T.

14.11.2018 13:22:40

Werner
AW: Excel teilen

14.11.2018 13:27:52

Rudi
da ich jetzt auch schon....

14.11.2018 15:00:23

Werner

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

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

Beliebteste Forumthreads (12 Monate)

Forumthread: Excel teilen

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread