Tworzenie nowych plików uzależnionych od grup

Hej jakiś czas temu Trebor napisał mi makro do problemu opisanego
Kod:
http://www.excelforum.pl/...p-w-vt16653.htm

Chciałem jeszcze poprosić o zmodyfikowanie tego makra:

Kod:

Sub rozpisz()
Dim kolekcja As New Collection, dane As Variant, i As Long, ostatnia As Long, ost As Integer
ostatnia = Columns("A:G").Find(What:="*", after:=Cells(1, 1), _
               SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

' w pozycji ostatnia = Columns("A:G") wpisujemy zakres kolumn naszej bazy

zakres = Range("A2:G" & ostatnia)

' modyfikujemy pozycję ":G" tzn. zakres bazy, analogicznie to co wyżej

On Error Resume Next
For i = 1 To ostatnia - 1
kolekcja.Add zakres(i, 4), CStr(zakres(i, 4))

' w kodzie powyżej po "i," dwa razy wpisujemy liczbę,
' która odpowiada kolumnie po której ma rozdzielać dane

Next i

For i = 1 To kolekcja.Count
Sheets.Add(after:=Sheets(Sheets.Count)).Name = kolekcja(i)
Sheets(kolekcja(i)).Cells(1, 1) = "Nr ewid"
Sheets(kolekcja(i)).Cells(1, 2) = "Nazwisko"
Sheets(kolekcja(i)).Cells(1, 3) = "Imie"
Sheets(kolekcja(i)).Cells(1, 4) = "Kom"
Sheets(kolekcja(i)).Cells(1, 5) = "Komorka organiz."
Sheets(kolekcja(i)).Cells(1, 6) = "Stanowisko"
Sheets(kolekcja(i)).Cells(1, 7) = "MPK"

' powyżej wpisujemy tyle linijek kodu z zachowaniem narastającego numerowania tyle ile jest kolumn
' wraz z nazwami kolumn
Next i
On Error GoTo 0

For i = 1 To ostatnia - 1
ost = Sheets(zakres(i, 4)).Columns("A:G").Find(What:="*", after:=Sheets(zakres(i, 4)).Cells(1, 1), _
               SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

' analogicznie jak wyżej po "i" wpisujemy po której kolumnie ma dzielić
' pamietamy o zmianie zakresu kolumn

Sheets(zakres(i, 4)).Cells(ost, 1) = zakres(i, 1)
Sheets(zakres(i, 4)).Cells(ost, 2) = zakres(i, 2)
Sheets(zakres(i, 4)).Cells(ost, 3) = zakres(i, 3)
Sheets(zakres(i, 4)).Cells(ost, 4) = zakres(i, 4)
Sheets(zakres(i, 4)).Cells(ost, 5) = zakres(i, 5)
Sheets(zakres(i, 4)).Cells(ost, 6) = zakres(i, 6)
Sheets(zakres(i, 4)).Cells(ost, 7) = zakres(i, 7)

' analogicznie jak wyżej tyle linijek kodu co kolumn
' po pierwszym "i" po której kolumnie ma filtrować
' po drugim "i" numerowanie rosnąco kolumn

Next i

' linijki kodu poniżej uruchamiają procedurę nazywania obszarów baz wg. wzorca "baza_" i symbol kom. org
' w dwóch miejscach poniżej trzeba zmienić zakresy tj. 1) .Columns("A:G") oraz 2).Range("A1:G" & ost)

For i = 1 To kolekcja.Count
ost = Sheets(kolekcja(i)).Columns("A:G").Find(What:="*", after:=Sheets(kolekcja(i)).Cells(1, 1), _
               SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
ThisWorkbook.Names.Add Name:="baza_" & kolekcja(i), RefersToLocal:=Sheets(kolekcja(i)).Range("A1:G" & ost)
Next i

End Sub

tak, aby zamiast nowych arkuszy z określonymi nazwami tworzyły się PLIKI, które:

1. zostaną wyeksportowane do katalogu w którym znajduje się główny plik do podziału.
2. nazwa pliku = taka sama jak grupa np. A01,
3. nazwa arkusza musi pozostać taka sama co w pliku macierzystym.
4. dla nowo powstałych baz (chodzi o zakres jakie zajmują) w nowopowstałych plikach z automatu zdefiniować jednolitą nazwę "baza" - arkusz zajmowany przez tą bazę musi mieć status "very hidden"
5. W nowopowstałych plikach będzie ukryty arkusz w którym będzie baza o której mowa wyżej + 1 pusty arkusz.

Z góry dziękuję za pomocLink

zanotowane.pl

doc.pisz.pl

pdf.pisz.pl

katkaras.opx.pl