Power Query jest narzędziem, które świetnie radzi sobie z łączeniem danych pochodzących z wielu źródeł. Często z jego wykorzystaniem łączymy podzielone dane znajdujące się w kilku arkuszach lub kilku skoroszytach. Co w sytuacji gdy chcemy przeprowadzić proces odwrotny do wspomnianego? Co gdy chcielibyśmy zrobić podział danych na arkusze i na skoroszyty? Tutaj Power Query nie będzie w stanie nam pomóc. Musimy posiłkować się makrami w VBA.
Kliknij aby przeczytać inne wpisy o Power Query.
Kliknij aby przeczytać inne wpisy o makrach VBA.
Podział danych na arkusze Excel
Nasza pojedyncza tabela z danymi, użyta na potrzeby tego wpisu, zawiera dane zgromadzone w 7miu kolumnach. Dla nas kluczowa będzie kolumna pierwsza zawierająca kolejne numery jednostek. Na jej podstawie będziemy chcieli przenieść makrem dane odpowiadające kolejnym jednostkom do osobnych arkuszy. Ilość wartości unikatowych w tej kolumnie to 4, odpowiadają kolejno jednostkom 101, 201, 301 i 401. W wyniku działania makra powinniśmy zatem otrzymać w skoroszycie 4 dodatkowe arkusze z podzielonymi danymi.
Makro będzie zaprogramowane w ten sposób, aby zmienne parametry można ustawić na jego początku – zaraz po zdefiniowaniu rodzajów zmiennych obiektowych. Dzięki temu kod można w łatwy sposób dostosować do tabeli składającej się z ilości kolumn innej niż 7. Odpowiednią zmienną ustawimy także kolumną wg której podział ma zostać przeprowadzony. Za to będzie odpowiadał poniższy fragment kodu razem z zadeklarowanymi zmiennymi typu Integer:
Dim intColumns As Integer
Dim intFilter As Integer
intColumns = 7 ' zmienna z ilością kolumn do skopiowania
intFilter = 1 ' zmienna określająca, w/g której kolumny mamy tworzyć arkusze
W następnym kroku makra precyzujemy, w którym dokładnie arkuszu znajdują się nasze dane. Najczęściej będzie to arkusz pierwszy. Dodatkowo określamy maksymalną ilość wierszy w naszej bazie. Tutaj ustawiamy 900 000.
'zapamiętujemy sobie bieżący arkusz z danymi w zmiennej
Set shData = ThisWorkbook.Sheets(1)
'ile wierszy danych
lngLstRow = shData.Cells(900000, intFilter).End(xlUp).Row
Następnie makro musi określić nazwy naszych unikatów oraz ich ilość. Przeliczenie zajdzie w tymczasowym arkuszu, który zostanie dodany do naszego skoroszytu na czas działania makra. Na końcu będziemy go usuwać.
'Dodajemy arkusz na unikaty
Set shUnique = Worksheets.Add(After:=Worksheets(Worksheets.Count))
'Tworzymy unikaty z naszej kolumny
shData.Columns(intFilter).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=shUnique.Range("A1"), Unique:=True
'Liczymy ile ich jest
lngLstUnique = shUnique.Range("A65536").End(xlUp).Row
Pętla For i / Next
Następny fragment kodu to tak naprawdę część najważniejsza, silnik całego makra. W obrębie pętli For i / Next najpierw przefiltrujemy i zdefiniujemy kolejne unikaty z naszego arkusza tymczasowego, a następnie odfiltrujemy je z tabeli bazowej oraz przekleimy do nowo powstałego arkusza, który otrzyma nazwę taką jak aktualnie wyfiltrowany unikat. Pętla będzie działać dopóki nie przejdzie przez wszystkie nasze unikaty. W naszym przykładzie będzie ich 4 ale z powodzeniem zadziała np. na 100 unikatach. Odbywa się to dzięki zmiennej lngLstUnique przechowującej ilość unikatów znajdujących się w naszej bazie.
'dla każdego unikatu
For i = 2 To lngLstUnique
With shData
'filtruj w/g unikatów
.Range(.Cells(1, 1), .Cells(lngLstRow, intColumns)).AutoFilter Field:=intFilter, Criteria1:=shUnique.Range("A" & i).Text
' wybierz "przefiltrowane" komórki
Set rngToCopy = .Range(.Cells(1, 1), .Cells(lngLstRow, intColumns)).SpecialCells(xlCellTypeVisible)
'utwórz nowy arkusz
Set shNew = Worksheets.Add(After:=Worksheets(Worksheets.Count))
'przekopiuj do niego przefiltrowane dane
rngToCopy.Copy Destination:=Worksheets(Worksheets.Count).Range("A1")
'zmień nazwę arkusza
ActiveSheet.Name = shUnique.Range("A" & i).Text
End With
Next
Po przejściu pętli przez wszystkie unikaty i podzielenie naszych danych na arkusze makro wychodzi z pętli. Kolejnym krokiem jest usunięcie już niepotrzebnego tymczasowego arkusza z listą unikatów. Standardowo przy próbie skasowania arkusza Excel zawsze pyta użytkownika czy na pewno chce to zrobić. Aby nie zakłócać działania makra dodatkowymi MsgBoxami czasowo wyłączamy alerty Excela. Po usunięciu arkusza włączamy je ponownie. Ściągamy także filtr z naszej bazowej tabeli tak aby dane nie były zafiltrowane na ostatnim z naszych unikatów.
Application.DisplayAlerts = False
'usuwamy arkusz z unikatami
shUnique.Delete
Application.DisplayAlerts = True
'pokaż wszystkie dane w autofiltrze
shData.ShowAllData
Na samym końcu procedury dodajemy jeszcze tzw. czyszczenie, czyli zresetowanie wcześniej ustawionych zmiennych obiektowych. Pamiętamy także o obsłudze błędów. Warto w tym miejscu wspomnieć o poleceniu Application.ScreenUpdating. Dzięki niej zablokujemy przeskakiwanie okien co sprawi, że nasze makro nieco przyspieszy w działaniu. Będzie to szczególnie zauważalne przy większej ilości zmiennych unikatów.
W efekcie działania makra, w mgnieniu oka, dostajemy nowe arkusze z podzielonymi danymi. Wyobraźcie sobie stratę czasu gdyby tak przyszło Wam podzielić ręcznie np. 50 takich arkuszy 🙂
Całość procedury „Podziel na arkusze”
Sub Podziel_na_arkusze()
Dim shNew As Worksheet
Dim shUnique As Worksheet
Dim shData As Worksheet
Dim intColumns As Integer
Dim intFilter As Integer
Dim lngLstUnique As Long, lngLstRow As Long, i As Long
Dim rngToCopy As Range
On Error GoTo Podziel_na_arkusze_Error
'wyłączamy odświeżanie okien
Application.ScreenUpdating = False
' sprawy do ustawienia wg potrzeb
intColumns = 7 ' zmienna z ilością kolumn do skopiowania
intFilter = 1 ' zmienna określająca, w/g której kolumny mamy tworzyć pliki
'zapamiętujemy sobie bieżący arkusz z danymi w zmiennej
Set shData = ThisWorkbook.Sheets(1)
'ile wierszy danych
lngLstRow = shData.Cells(900000, intFilter).End(xlUp).Row
'Dodajemy arkusz na unikaty
Set shUnique = Worksheets.Add(After:=Worksheets(Worksheets.Count))
'Tworzymy unikaty z naszej kolumny
shData.Columns(intFilter).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=shUnique.Range("A1"), Unique:=True
'Liczymy ile ich jest
lngLstUnique = shUnique.Range("A65536").End(xlUp).Row
If lngLstUnique > 1 Then ' jeżeli jest choć jeden (oprócz nagłówka)
'dla każdego unikatu
For i = 2 To lngLstUnique
With shData
'filtruj w/g unikatów
.Range(.Cells(1, 1), .Cells(lngLstRow, intColumns)).AutoFilter Field:=intFilter, Criteria1:=shUnique.Range("A" & i).Text
' wybierz "przefiltrowane" komórki
Set rngToCopy = .Range(.Cells(1, 1), .Cells(lngLstRow, intColumns)).SpecialCells(xlCellTypeVisible)
'utwórz nowy arkusz
Set shNew = Worksheets.Add(After:=Worksheets(Worksheets.Count))
'przekopiuj do niego przefiltrowane dane
rngToCopy.Copy Destination:=Worksheets(Worksheets.Count).Range("A1")
'zmień nazwę arkusza
ActiveSheet.Name = shUnique.Range("A" & i).Text
End With
Next
End If
Application.DisplayAlerts = False
'usuwamy arkusz z unikatami
shUnique.Delete
Application.DisplayAlerts = True
'pokaż wszystkie dane w autofiltrze
shData.ShowAllData
Clean:
'Sprzątanie
Set rngToCopy = Nothing
Set shNew = Nothing
Set shData = Nothing
Set shUnique = Nothing
On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub
'obsługa błędów
Podziel_na_arkusze_Error:
MsgBox "Bląd " & Err.Number & " (" & Err.Description & ") w procedurze Podziel_na_arkusze"
Resume Clean
End Sub
Podział danych na skoroszyty – osobne pliki .xlsx
Drugie makro również podzieli nasze dane, ale tym razem nie na arkusze, a na nowe skoroszyty, czyli de facto osobne pliki. Sam kod pozostanie bez większych zmian. Na początku makra musimy zdefiniować ścieżkę do folderu, w którym zapisywane będą nowe pliki po przeprowadzeniu podziału. Tutaj określamy ją jaką folder, w którym znajduje się nasz plik bazowy z tabelą do podziały. Zatem początkowy fragment kodu, po deklaracji zmiennych oraz włączaniu obsługi błędów, będzie wyglądał następująco:
' sprawy do ustawienia wg potrzeb
intColumns = 7 ' zmienna z ilością kolumn do skopiowania
intFilter = 1 ' zmienna określająca, w/g której kolumny mamy tworzyć pliki
strPath = ThisWorkbook.Path & "" 'scieżka gdzie tworzymy pliki
W dalszej części kodu analogicznie jak poprzednio określamy arkusz bazowy, maksymalną ilość wierszy oraz tworzymy tymczasowy arkusz na unikaty.
Kilka zmian musimy zastosować natomiast w naszym silniku, czyli pętli For i / Next. W związku z podziałem na nowe pliki będziemy chcieli sprawdzić czy w folderze skoroszyt jaki chcemy utworzyć już przypadkiem nie istnieje. Dodatkowo kod zamiast dodawać arkusz jak poprzednio, będzie tworzył nowy skoroszyt Excel i do niego wklejał zafiltrowane dane. Przed wyjściem z pętli plik zostanie zapisany pod nazwą aktualnego unikatu oraz zamknięty.
For i = 2 To lngLstUnique
With shData
'filtruj w/g unikatów
.Range(.Cells(1, 1), .Cells(lngLstRow, intColumns)).AutoFilter Field:=intFilter, Criteria1:=shUnique.Range("A" & i).Text
'sprawdzamy czy nie ma już pliku o nazwie pozycji z filtra
If Dir(strPath & shUnique.Range("A" & i).Text & ".xls") = "" Then
' wybierz "przefiltrowane" komórki
Set rngToCopy = .Range(.Cells(1, 1), .Cells(lngLstRow, intColumns)).SpecialCells(xlCellTypeVisible)
'utwórz nowy skoroszyt
Set wkNew = Workbooks.Add
'przekopiuj do niego przefiltrowane dane
rngToCopy.Copy Destination:=wkNew.Worksheets(1).Range("A1")
'zapisz - jako nazwa pozycja filtra
wkNew.SaveAs Filename:=strPath & shUnique.Range("A" & i).Text
'zamknij
wkNew.Close
Else
MsgBox "Istnieje już plik " & strPath & shUnique.Range("A" & i).Text & ".xlsx"
End If
End With
Next
Po wyjściu z pętli, analogicznie jak poprzednio kasujemy tymczasowy arkusz na unikaty, resetujemy zmienne obiektowe, dodajemy obsługę błędów. W efekcie działania makra otrzymamy 4 nowe pliki umieszczone w folderze z naszym plikiem bazowym. Pliki z powodzeniem możemy udostępnić teraz np. naszym współpracownikom jednocześnie nie udostępniając im całej naszej bazy danych.
Pełna treść kodu VBA dla makra „Podziel na skoroszyty”
Sub Podziel_na_skoroszyty()
Dim wkNew As Workbook
Dim shUnique As Worksheet
Dim shData As Worksheet
Dim intColumns As Integer
Dim intFilter As Integer
Dim lngLstUnique As Long, lngLstRow As Long, i As Long
Dim strPath As String
Dim rngToCopy As Range
On Error GoTo Podziel_na_skoroszyty_Error
'wyłączamy odświeżanie okien
Application.ScreenUpdating = False
' sprawy do ustawienia wg potrzeb
intColumns = 7 ' zmienna z ilością kolumn do skopiowania
intFilter = 1 ' zmienna określająca, w/g której kolumny mamy tworzyć pliki
strPath = ThisWorkbook.Path & "" 'scieżka gdzie tworzymy pliki
'zapamiętujemy sobie bieżący arkusz z danymi w zmiennej
Set shData = ThisWorkbook.Sheets(1)
'ile wierszy danych
lngLstRow = shData.Cells(900000, intFilter).End(xlUp).Row
'Dodajemy arkusz na unikaty
Set shUnique = Worksheets.Add(After:=Worksheets(Worksheets.Count))
'Tworzymy unikaty z naszej kolumny
shData.Columns(intFilter).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=shUnique.Range("A1"), Unique:=True
'Liczymy ile ich jest
lngLstUnique = shUnique.Range("A65536").End(xlUp).Row
If lngLstUnique > 1 Then ' jeżeli jest choć jeden (oprócz nagłówka)
'dla każdego unikatu
For i = 2 To lngLstUnique
With shData
'filtruj w/g unikatów
.Range(.Cells(1, 1), .Cells(lngLstRow, intColumns)).AutoFilter Field:=intFilter, Criteria1:=shUnique.Range("A" & i).Text
'sprawdzamy czy nie ma już pliku o nazwie pozycji z filtra
If Dir(strPath & shUnique.Range("A" & i).Text & ".xls") = "" Then
' wybierz "przefiltrowane" komórki
Set rngToCopy = .Range(.Cells(1, 1), .Cells(lngLstRow, intColumns)).SpecialCells(xlCellTypeVisible)
'utwórz nowy skoroszyt
Set wkNew = Workbooks.Add
'przekopiuj do niego przefiltrowane dane
rngToCopy.Copy Destination:=wkNew.Worksheets(1).Range("A1")
'zapisz - jako nazwa pozycja filtra
wkNew.SaveAs Filename:=strPath & shUnique.Range("A" & i).Text
'zamknij
wkNew.Close
Else
MsgBox "Istnieje już plik " & strPath & shUnique.Range("A" & i).Text & ".xls"
End If
End With
Next
End If
Application.DisplayAlerts = False
'usuwamy arkusz z unikatami
shUnique.Delete
Application.DisplayAlerts = True
'pokaż wszystkie dane w autofiltrze
shData.ShowAllData
Clean:
'Sprzątanie
Set rngToCopy = Nothing
Set wkNew = Nothing
Set shData = Nothing
Set shUnique = Nothing
On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub
'obsługa błędów
Podziel_na_skoroszyty_Error:
MsgBox "Bląd " & Err.Number & " (" & Err.Description & ") w procedurze Podziel_na_skoroszyty"
Resume Clean
End Sub
Dzień dobry
Mam pytanie próbowałam uruchomić skrypt jednak pojawia mi się błąd
method showalldata of object _worksheet failed
W jaki sposób rozwiązać ten błąd? Nie jestem osobą biegłą w vba więc tak naprawdę nie wiem od czego zacząć.
Cześć,
Najlepiej jak zaczniesz od krokowego uruchomienia skryptu to wtedy zobaczysz na której linii kodu jest zwracany Twój komunikat z błędem. To powinno Ci zasugerować co jest przyczyną
Cześć,
Super działa, da się do tego jeszcze dopisać linijkę z kopiowaniem formatowania źródłowego przy podziale na arkusze , tak aby przenieść to z tabeli która dzielimy ?
Pozdrawiam
Cześć,
Po odpowiednim dopasowaniu do Twojego arkusza, spróbuj wykorzystać:
Worksheets(„Arkusz1”).Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
A czy możesz wkleić cały kod makra dzielącego na oddzielne pliki z uwzgędnieniem formatowania (chodzi i szerokość kolumn i wielkość czcionki) gdzie dane są dzielone po 1 kolumnie, kolumn jest 20, wierszy 12 000 i pliki mają być nazwane po 1 kolumnie 🙂
Mam lekko zmodyfikowane Twoje makro, które pozwala mi specjalnie nazwać pliki w pierwszej kolumnie „xyz” która sie potem kasuje z plików podzielonych więc może mieć plik inną nazwę niż zawartość 1-wszej kolumny, ale kurczę potem mam wąskie kolumny i muszę w każdy plik wchodzić i je poszerzać ręcznie do szerokości „zawartości” mimo, że w pliku źródłowym jest tak jak chcę:
Sub Podziel_na_skoroszyty()
Dim wkNew As Workbook
Dim shUnique As Worksheet
Dim shData As Worksheet
Dim intColumns As Integer
Dim intFilter As Integer
Dim lngLstUnique As Long, lngLstRow As Long, i As Long
Dim strPath As String
Dim rngToCopy As Range
On Error GoTo Podziel_na_skoroszyty_Error
‚wyłączamy odświeżanie okien
Application.ScreenUpdating = False
‚ sprawy do ustawienia wg potrzeb
intColumns = 12 ‚ zmienna z ilością kolumn do skopiowania
intFilter = 1 ‚ zmienna określająca, w/g której kolumny mamy tworzyć pliki
strPath = ThisWorkbook.Path & „” ‚C:\Users\paulinakrawczyk00\Documents\test makr\ankieta kadrowa 01.06.2022_
‚zapamiętujemy sobie bieżący arkusz z danymi w zmiennej
Set shData = ThisWorkbook.Sheets(1)
‚ile wierszy danych
lngLstRow = shData.Cells(900000, intFilter).End(xlUp).Row
‚Dodajemy arkusz na unikaty
Set shUnique = Worksheets.Add(After:=Worksheets(Worksheets.Count))
‚Tworzymy unikaty z naszej kolumny
shData.Columns(intFilter).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=shUnique.Range(„A1”), Unique:=True
‚Liczymy ile ich jest
lngLstUnique = shUnique.Range(„A65536”).End(xlUp).Row
If lngLstUnique > 1 Then ‚ jeżeli jest choć jeden (oprócz nagłówka)
‚dla każdego unikatu
For i = 2 To lngLstUnique
With shData
‚filtruj w/g unikatów
.Range(.Cells(1, 1), .Cells(lngLstRow, intColumns)).AutoFilter Field:=intFilter, Criteria1:=shUnique.Range(„A” & i).Text
‚sprawdzamy czy nie ma już pliku o nazwie pozycji z filtra
If Dir(strPath & shUnique.Range(„A” & i).Text & „.xls”) = „” Then
‚ wybierz „przefiltrowane” komórki
Set rngToCopy = .Range(.Cells(1, 1), .Cells(lngLstRow, intColumns)).SpecialCells(xlCellTypeVisible)
‚utwórz nowy skoroszyt
Set wkNew = Workbooks.Add
‚przekopiuj do niego przefiltrowane dane
rngToCopy.Copy Destination:=wkNew.Worksheets(1).Range(„A1”)
Range(„A1″).Select
Cells.Find(What:=”xyz”, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Selection.EntireColumn.Delete
‚zapisz – jako nazwa pozycja filtra
wkNew.SaveAs Filename:=strPath & shUnique.Range(„A” & i).Text
‚zamknij
wkNew.Close
Else
MsgBox „Istnieje już plik ” & strPath & shUnique.Range(„A” & i).Text & „.xls”
End If
End With
Next
End If
Application.DisplayAlerts = False
‚usuwamy arkusz z unikatami
shUnique.Delete
Application.DisplayAlerts = True
‚pokaż wszystkie dane w autofiltrze
shData.ShowAllData
Clean:
‚Sprzątanie
Set rngToCopy = Nothing
Set wkNew = Nothing
Set shData = Nothing
Set shUnique = Nothing
On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub
‚obsługa błędów
Podziel_na_skoroszyty_Error:
MsgBox „Bląd ” & Err.Number & ” (” & Err.Description & „) w procedurze Podziel_na_skoroszyty”
Resume Clean
End Sub
Witam,
super sprawa ten kodzik, do pełni szczęścia proszę o informacje jak zmodyfikować kod żeby dzielił na skoroszyty i zapisywał jako pdf a nie xls
Cześć,
Polecenie zapisanie pliku do PDF wygląda w VBA w ten sposób:
Dim saveLocation As String
saveLocation = „C:\Users\xxx\Documents\nazwaPDF.pdf”
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation
Cześć,
dziękuje za podpowiedz, maj mam jeszcze jedno pytanie, do pierwszego skopiowanego arkusza wklejane są formuły, natomiast kolejne już nie formuły a wartości. nie rozumiem co jest przyczyną?
Cześć ponownie,
Pierwszy arkusz to Twoja baza więc może zawierać formuły. Arkusze wynikowe po podziale zawierają dane wklejone jako wartości – bez formuł źródłowych z arkusza bazowego.
cześć,
chodzi o arkusze po podziale, pierwszy z nich nie zawiera wartości a jedynie formuły(odnośniki do pierwotnego pliku, dodatkowo famuły zawierają błędy wiec nie wyświetlają się żadne wyniki), pozostałe arkusze zawierają wartości.
Cześć,
W jaki sposób mogę zmodyfikować te makro, aby filtrowało po danych które zaczynają się w 4 wierszu? I kopiowały 3 pierwsze wiersze.
Pozdrawiam serdecznie.
Cześć,
Zacząłbym od zmiany sposobu tworzenia listy unikatów do przefiltrowania – tak żeby unikaty były pobierane od wiersza 4.
Makro jest super. ALe mam pytanie. w skoroszycie który chcę podzielić mam kilkanaście arkuszy. 5 z nich chcę podzielić wg tego samego klucza. a resztę akruszy skopiować.
Czyli mam plik bazowy z 10 arkuszami. W 5 mam dane do podzielnia wg klucza a reszta do skopiowania. Jeżeli unikalnych wartości wg których dzielę mam 3 (w rzeczywistości jest duuuużo więcej), to chcę dostać 3 oddzielne excele i w każdym z nim pierwszych 5 arkuszy dzielonych wg klucza i pozostałe 5 arkuszy skopiowanych w całości.
Jak zmodyfikować kod do tego?
Cześć,
Tutaj sprawa jest trochę bardziej złożona. Spróbuj kod dzielący jeden arkusz obłożyć kolejną pętlą For i = 1 To 5, w której przejdziesz przez arkusze do podziału. Potem ustawiłbym kolejną (już osobną pętlę), która arkusze 6 i dalej skopiuje w całości, czyli For i = 6 To Sheets.Count
Dzień dobry, w drugiej linijce wyskakuje błąd, czy może Pan jakoś pomóc?
shData.Columns(intFilter).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=shUnique.Range(„A1”), Unique:=True
Dzień dobry,
Proszę przesłać komunikat błędu na mojego maila. Można też załączyć plik z Pani oryginalnymi danymi lub spreparowanymi jeśli są wrażliwe.
Witaj,
makro jest genialne i prawie u mnie działa 🙂 Dzieli konkretną bazę na poszczególne arkusze według unikatów, ale niestety „nowopowstałe” arkusze nie kopiują formuł które są bazie. Jak można rozwiązać ten problem (by arkusze zawierały formuły) ? Z góry wielkie dzięki ! 🙂
Cześć,
W takim wypadku musiałabyś przerobić nieco mechanizm wklejania i skorzystać z polecenia Paste z parametrem xlPasteFormulas. W razie wątpliwości podeślij mi proszę na maila Twój skoroszyt z obecną wersją marka i spróbuję Ci pomóc.
Cześć,
Ja mam kłopot taki że makro nie zapisuje podzielonych plików tam gdzie chcę, a zapisuje je w miejscu gdzie ostatnio zapisałem jakikolwiek inny plik Excel, zupełnie nie związany z tematem, np. jakiś załącznik z maila czy inny plik wcześniej otwarty i zapisany. Jak to rozwiązać abym mógł zapisać podzielone pliki tam gdzie chcę? 🙁
OK, rozwiązałem ten problem, wystarczyło w linijce:
strPath = ThisWorkbook.Path & „” dodać \ pomiędzy „” 😀
Ale mam dodatkowe pytanie: czy istnieje sposób aby ogarnąć makrem wysłanie utworzonych plików na mail ze stałą treścią, gdzie załóżmy że posiadam bazę adresów e-mail „sparowaną” z informacją na podstawie której pliki są dzielone a tym samym nazywane. Będe Wdzięczny za podpowiedź 🙂
Tak, wysyłką mailową da się sterować z poziomu VBA w Excelu. Jest na to nawet kilka metod. Ja akurat nie opisywałem żadnej z nich, ale w sieci na pewno znajdziesz sporo artykułów na ten temat.
cześć
Mam pytanie – gdybym chciał podzielić arkusz na osobne skoroszyty ale umieszczone na sharepoincie?
Cześć,
Musiałbyś zmienić ścieżkę zapisu pliku po podziale na lokalizację w Sharepoint.
U mnie działa, super makro 🙂 Wielkie dzięki!
Bardzo proszę 🙂
wiem że trochę pytanie laika ale w którym miejscu umieścić kod do formatowania arkusza tak jak w bazowym?
Ja bym spróbował w tym miejscu zamiast metody .Copy Destination:
‚przekopiuj do niego przefiltrowane dane
rngToCopy.Copy Destination:=Worksheets(Worksheets.Count).Range(„A1”)