Karol W.

Karol W. Technik Logistyk

Temat: podział danych + nagłówek tabeli + nazwa arkuszy

Witam, posiadam kod do dzielenia danych na kolejne arkusze. Potrzebuje go zmodyfikować o możliwość
1. Wklejenia nagłówka tabeli z arkusza który dziele (pierwszy wiersz głównej tabeli), do każdego nowego arkusza.
2. Pobieranie nazwy arkusza z komórki w innym arkuszu "temp".
poniżej kod:
Sub SplitWorksheet()
Dim lngLastRow As Long
Dim lngNumberOfRows As Long
Dim lngI As Long
Dim strMainSheetName As String
Dim currSheet As Worksheet
Dim prevSheet As Worksheet
'Number of rows to split among worksheets
lngNumberOfRows = 4000
'Current worksheet in workbook
Set prevSheet = ThisWorkbook.ActiveSheet
'First worksheet name
strMainSheetName = prevSheet.Name
'Number of rows in worksheet
lngLastRow = prevSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Worksheet counter for added worksheets
lngI = 1
While lngLastRow > lngNumberOfRows
Set currSheet = ThisWorkbook.Worksheets.Add
With currSheet
.Move after:=Worksheets(Worksheets.Count)
.Name = strMainSheetName + "(" + CStr(lngI) + ")"
End With

With prevSheet.Rows(lngNumberOfRows + 1 & ":" & lngLastRow).EntireRow
.Cut currSheet.Range("A1")
End With

lngLastRow = currSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set prevSheet = currSheet
lngI = lngI + 1
Wend
End SubTen post został edytowany przez Autora dnia 03.09.15 o godzinie 21:57

Wojciech Gardziński

Wypowiedzi autora zostały ukryte. Pokaż autora
Oskar Shon

Oskar Shon Dodatki do Office
www.VBATools.pl

Temat: podział danych + nagłówek tabeli + nazwa arkuszy

No to ja polecę innego gotowca:


Obrazek

Następna dyskusja:

Kopiowanie danych z tabeli ...




Wyślij zaproszenie do