Excel VBA — kurs od podstaw z 25 praktycznymi makrami

Excel VBA — czym jest i dlaczego warto uczyć się go w 2026 roku?

Excel VBA (Visual Basic for Applications) to wbudowany język programowania Microsoftu, który pozwala automatyzować powtarzalne zadania, tworzyć własne funkcje i budować zaawansowane rozwiązania bezpośrednio w arkuszach kalkulacyjnych. Jeśli codziennie ręcznie kopiujesz dane, piszesz te same raporty, formatujesz tabele czy wysyłasz maile z Excela — ten kurs excel vba od podstaw zmieni Twój sposób pracy raz na zawsze. W jednym artykule znajdziesz kompletne wprowadzenie: od konfiguracji środowiska, przez typy danych i pętle, aż po 25 gotowych makr excel z pełnym, skomentowanym po polsku kodem, który możesz skopiować i uruchomić natychmiast.

W tym przewodniku otrzymasz: krok po kroku konfigurację edytora VBE (Visual Basic Editor), tabelę wszystkich typów danych VBA, tabelę ustawień bezpieczeństwa makr, omówienie pętli i obsługi błędów oraz — co najważniejsze — 25 działających makr podzielonych na kategorie: formatowanie, zarządzanie plikami, raporty, tabele przestawne, czyszczenie danych i wysyłka przez Outlook. Każde makro zawiera polskie komentarze wyjaśniające każdą linię kodu.

Zanim przejdziesz dalej: makra VBA dostępne są w desktopowej wersji Excela wchodzącej w skład pakietów Office, a nie w Excelu uruchamianym wyłącznie w przeglądarce. Jeśli korzystasz ze starszej wersji, rozważ przejście na Microsoft Office 2024 Professional Plus lub Microsoft Office 2024 Standard. Jeżeli pracujesz w modelu subskrypcyjnym, sprawdź też Microsoft 365 z aplikacjami klasycznymi pakietu Office.

Dlaczego Excel VBA wciąż ma sens w 2026 roku?

Pojawiają się głosy, że Python czy Office Scripts zastąpią VBA. Prawda jest prostsza: Excel VBA dla początkujących to wciąż najszybsza ścieżka do automatyzacji pracy biurowej w środowiskach korporacyjnych. Dziesiątki tysięcy firm w Polsce opierają swoje procesy na rozwiązaniach VBA pisanych przez lata. Umiejętność ich utrzymania i rozwijania to jedna z najbardziej pożądanych kompetencji analityków finansowych, pracowników działów HR, logistyki i controllingu.

Według oficjalnej dokumentacji Microsoft Learn dostępnej pod adresem learn.microsoft.com/pl-pl/office/vba/api/overview/excel — VBA dla Excela daje dostęp do ponad 900 obiektów, właściwości i metod umożliwiających pełną kontrolę nad arkuszem.

Jak uruchomić edytor VBA w Excel 2024 — konfiguracja krok po kroku

Bezpieczeństwo makr — ustawienia Centrum Zaufania

Przed uruchamianiem makr musisz skonfigurować ustawienia bezpieczeństwa. Znajdziesz je w Plik → Opcje → Centrum zaufania → Ustawienia Centrum zaufania → Ustawienia makr. Microsoft opisuje zmianę ustawień makr w Excelu w oficjalnej pomocy Zmienianie ustawień zabezpieczeń makr w programie Excel oraz ostrzega, aby włączać makra tylko w plikach, których działanie i pochodzenie rozumiesz. Poniższa tabela wyjaśnia różnice między dostępnymi poziomami:

Zalecenie praktyczne: korzystaj z ustawienia domyślnego (z powiadomieniem) i klikaj „Włącz zawartość" tylko w plikach, których pochodzenie znasz i którym ufasz. Nigdy nie włączaj makr w plikach przysłanych e-mailem przez nieznanych nadawców.

Typy danych VBA — kompletna tabela z przykładami

Deklarowanie zmiennych z właściwym typem danych to jeden z najważniejszych nawyków dobrego programisty VBA. Szczegółowe omówienie wszystkich typów znajdziesz w oficjalnej dokumentacji Microsoft Learn: Data Type Summary (learn.microsoft.com).

Podstawy składni VBA — zmienne, pętle i obsługa błędów

Ta część kursu opiera się na oficjalnych rozdziałach Microsoft Learn: Option Explicit statement, Declaring variables, Understanding scope and visibility, For Each...Next statement, On Error statement i Err object. W praktyce oznacza to trzy zasady: deklaruj zmienne jawnie, wybieraj typ danych świadomie i zawsze kończ makro ścieżką obsługi błędów, która przywraca ustawienia Excela.

Deklarowanie zmiennych i stałych

Option Explicit ' Wymuszaj deklarowanie wszystkich zmiennych  ' Makro 01: Podstawy deklarowania zmiennych i typów danych Sub Makro01_TypyDanych()  ' --- DEKLARACJE ZMIENNYCH ---  Dim nazwaFirmy As String ' tekst  Dim liczbaKlientow As Long ' liczba całkowita (preferuj Long nad Integer)  Dim przychodMiesieczny As Double ' liczba zmiennoprzecinkowa  Dim czyAktywny As Boolean ' wartość logiczna (True/False)  Dim dataKontraktu As Date ' data ' --- PRZYPISANIE WARTOŚCI ---  nazwaFirmy = "Kowalski Sp. z o.o."  liczbaKlientow = 1250  przychodMiesieczny = 98750.50  czyAktywny = True  dataKontraktu = #1/15/2026# ' Daty w VBA zapisujemy w formacie #MM/DD/YYYY# ' --- STAŁE (wartości niezmienne) ---  Const STAWKA_VAT As Double = 0.23 ' Stała dla stawki VAT 23%  Const NAZWA_FIRMY As String = "KluczeSoft.pl" ' Stała tekstowa ' --- WYŚWIETLENIE WYNIKU ---  MsgBox "Firma: " & nazwaFirmy & vbCrLf & _  "Klientów: " & liczbaKlientow & vbCrLf & _  "Aktywna: " & czyAktywny & vbCrLf & _  "Kontrakt od: " & Format(dataKontraktu, "dd.mm.yyyy"), _  vbInformation, "Dane firmy" End Sub 

Instrukcje warunkowe If…Then i Select Case

' Makro 02: Instrukcje warunkowe — przykład oceny wyników sprzedaży Sub Makro02_WarunkiIfCase()  Dim wynikSprzedazy As Double  Dim ocena As String ' Pobierz wartość z aktywnej komórki (zakładamy liczbę w A1)  wynikSprzedazy = CDbl(ActiveSheet.Range("A1").Value) ' --- PRZYKŁAD 1: If...Then...ElseIf...Else ---  If wynikSprzedazy >= 100000 Then  ocena = "Platynowy"  ElseIf wynikSprzedazy >= 50000 Then  ocena = "Złoty"  ElseIf wynikSprzedazy >= 20000 Then  ocena = "Srebrny"  Else  ocena = "Standardowy"  End If ' --- PRZYKŁAD 2: Select Case (czytelniejszy dla wielu opcji) ---  Select Case ocena  Case "Platynowy"  ActiveSheet.Range("B1").Interior.Color = RGB(200, 200, 255) ' jasnoniebieski  Case "Złoty"  ActiveSheet.Range("B1").Interior.Color = RGB(255, 215, 0) ' złoty  Case "Srebrny"  ActiveSheet.Range("B1").Interior.Color = RGB(192, 192, 192) ' srebrny  Case Else  ActiveSheet.Range("B1").Interior.Color = RGB(255, 255, 255) ' biały  End Select ActiveSheet.Range("B1").Value = ocena ' Wpisz ocenę do komórki B1  MsgBox "Wynik: " & wynikSprzedazy & " PLN" & vbCrLf & "Poziom: " & ocena, vbInformation, "Ocena sprzedawcy" End Sub 

Pętle — For Next, For Each, Do While

' Makro 03: Pętle — trzy najważniejsze typy w praktyce Sub Makro03_PetleRodzaje()  Dim i As Long ' licznik pętli For  Dim ws As Worksheet ' zmienna arkusza dla For Each  Dim wynik As Long ' akumulator ' --- PĘTLA 1: For...Next — klasyczna pętla z licznikiem ---  ' Wpisuje liczby 1-10 do kolumny A arkusza "Arkusz1"  For i = 1 To 10  Sheets("Arkusz1").Cells(i, 1).Value = i ' kolumna A, wiersz i  Sheets("Arkusz1").Cells(i, 2).Value = i ^ 2 ' kolumna B, kwadrat liczby  Next i ' --- PĘTLA 2: For Each...Next — iteracja po kolekcji obiektów ---  ' Wypisuje nazwy wszystkich arkuszy do okna Immediate (Ctrl+G w VBE)  For Each ws In ThisWorkbook.Worksheets  Debug.Print "Arkusz: " & ws.Name ' Debug.Print = wydruk w oknie Immediate  Next ws ' --- PĘTLA 3: Do While...Loop — pętla warunkowa ---  ' Sumuje wartości w kolumnie C dopóki komórka nie jest pusta  i = 1 ' zaczynamy od wiersza 1  wynik = 0 ' inicjalizujemy sumę Do While Sheets("Arkusz1").Cells(i, 3).Value <> ""  wynik = wynik + CLng(Sheets("Arkusz1").Cells(i, 3).Value)  i = i + 1 ' przejdź do kolejnego wiersza  Loop MsgBox "Suma wartości w kolumnie C: " & wynik, vbInformation, "Wynik sumowania" End Sub 

Obsługa błędów — On Error GoTo

' Makro 04: Profesjonalna obsługa błędów w VBA Sub Makro04_ObslugaBledow()  Dim wynik As Double  Dim dzielnik As Double ' Włącz obsługę błędów — przekieruj do etykiety "UchwycBlad"  On Error GoTo UchwycBlad dzielnik = CDbl(InputBox("Podaj dzielnik (wpisz 0, aby zobaczyć obsługę błędu):", "Test")) ' Ta linia wywoła błąd "Division by zero" jeśli dzielnik = 0  wynik = 100 / dzielnik MsgBox "Wynik: 100 / " & dzielnik & " = " & wynik, vbInformation, "Wynik" ' Instrukcja Exit Sub kończy normalny przepływ — pomija blok błędu  Exit Sub  UchwycBlad:  ' Obsługa błędu — Err.Number to kod błędu, Err.Description to opis  Select Case Err.Number  Case 11 ' Division by zero  MsgBox "Błąd: Nie można dzielić przez zero!" & vbCrLf & _  "Kod błędu: " & Err.Number, vbCritical, "Błąd matematyczny"  Case 13 ' Type mismatch  MsgBox "Błąd: Wpisano nieprawidłowy typ danych (oczekiwano liczby)." & vbCrLf & _  "Kod błędu: " & Err.Number, vbCritical, "Błąd typu"  Case Else  MsgBox "Nieoczekiwany błąd: " & Err.Description & vbCrLf & _  "Kod: " & Err.Number, vbCritical, "Błąd VBA"  End Select ' Wznów wykonanie od następnej linii po tej, która spowodowała błąd  Resume Next End Sub 

25 praktycznych makr Excel — gotowy kod do użycia od zaraz

Kategoria 1: Formatowanie i estetyka arkuszy

' Makro 05: Automatyczne dopasowanie szerokości kolumn i wysokości wierszy Sub Makro05_DopasujKolumnyWiersze()  Dim ws As Worksheet ' Wyłącz odświeżanie ekranu — kod wykona się wielokrotnie szybciej  Application.ScreenUpdating = False ' Iteruj po wszystkich arkuszach w tym skoroszycie  For Each ws In ThisWorkbook.Worksheets  ws.Cells.EntireColumn.AutoFit ' Dopasuj szerokość wszystkich kolumn  ws.Cells.EntireRow.AutoFit ' Dopasuj wysokość wszystkich wierszy  Next ws ' Przywróć odświeżanie ekranu  Application.ScreenUpdating = True MsgBox "Dopasowano kolumny i wiersze we wszystkich " & _  ThisWorkbook.Worksheets.Count & " arkuszach.", vbInformation, "Gotowe" End Sub 

' Makro 06: Dynamiczne formatowanie warunkowe wierszy na podstawie wartości w kolumnie Sub Makro06_FormatowanieWarunkowe()  Dim ws As Worksheet  Dim lastRow As Long ' ostatni wiersz z danymi  Dim i As Long ' licznik wierszy  Dim statusKomorki As String Application.ScreenUpdating = False ' Wyłącz ekran dla szybkości Set ws = ActiveSheet ' Pracuj na aktywnym arkuszu  lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' Znajdź ostatni wiersz w kolumnie A ' Iteruj po wierszach od 2 (pomijając nagłówek) do ostatniego wiersza  For i = 2 To lastRow  statusKomorki = ws.Cells(i, 3).Value ' Odczytaj status z kolumny C Select Case statusKomorki  Case "Opłacone"  ' Zielone tło dla opłaconych faktur  ws.Rows(i).Interior.Color = RGB(198, 239, 206)  ws.Rows(i).Font.Color = RGB(0, 97, 0)  Case "Oczekuje"  ' Żółte tło dla faktur oczekujących  ws.Rows(i).Interior.Color = RGB(255, 235, 156)  ws.Rows(i).Font.Color = RGB(156, 87, 0)  Case "Przeterminowane"  ' Czerwone tło dla przeterminowanych  ws.Rows(i).Interior.Color = RGB(255, 199, 206)  ws.Rows(i).Font.Color = RGB(156, 0, 6)  Case Else  ' Brak koloru — biały  ws.Rows(i).Interior.ColorIndex = xlNone  ws.Rows(i).Font.ColorIndex = xlAutomatic  End Select  Next i Application.ScreenUpdating = True ' Przywróć ekran  MsgBox "Formatowanie zastosowane dla " & (lastRow - 1) & " wierszy.", vbInformation, "Gotowe" End Sub 

' Makro 07: Podświetlanie duplikatów w wybranej kolumnie Sub Makro07_PodswietlDuplikaty()  Dim zakres As Range ' zakres do sprawdzenia  Dim komorka As Range ' pojedyncza komórka  Dim slownik As Object ' słownik do liczenia wystąpień  Dim klucz As String ' Utwórz obiekt słownika (Scripting.Dictionary) do zliczania wartości  Set slownik = CreateObject("Scripting.Dictionary")  slownik.CompareMode = 1 ' Porównuj bez uwzględnienia wielkości liter ' Pobierz zaznaczony zakres od użytkownika lub użyj kolumny A  If TypeName(Selection) = "Range" And Selection.Cells.Count > 1 Then  Set zakres = Selection  Else  ' Domyślnie: cała kolumna A z danymi na aktywnym arkuszu  Set zakres = ActiveSheet.Range("A1:A" & ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row)  End If ' PRZEJŚCIE 1: Zlicz wystąpienia każdej wartości  For Each komorka In zakres  klucz = CStr(komorka.Value)  If klucz <> "" Then ' Pomiń puste komórki  If slownik.Exists(klucz) Then  slownik(klucz) = slownik(klucz) + 1 ' Zwiększ licznik  Else  slownik.Add klucz, 1 ' Dodaj nowy klucz  End If  End If  Next komorka ' PRZEJŚCIE 2: Pokoloruj duplikaty  For Each komorka In zakres  klucz = CStr(komorka.Value)  If klucz <> "" And slownik.Exists(klucz) Then  If slownik(klucz) > 1 Then  komorka.Interior.Color = RGB(255, 153, 51) ' Pomarańczowe tło dla duplikatów  End If  End If  Next komorka MsgBox "Duplikaty podświetlone.", vbInformation, "Gotowe" End Sub 

Kategoria 2: Zarządzanie danymi i ich czyszczenie

' Makro 08: Usuwanie pustych wierszy z aktywnego arkusza Sub Makro08_UsunPusteWiersze()  Dim lastRow As Long ' ostatni wiersz z danymi  Dim i As Long ' licznik — iterujemy OD DÓŁ żeby nie pominąć wierszy  Dim licznikUsunietych As Long Application.ScreenUpdating = False ' Wyłącz ekran dla szybkości lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row  licznikUsunietych = 0 ' WAŻNE: iteruj od ostatniego wiersza w górę!  ' Jeśli idziesz od góry i usuniesz wiersz, numeracja się przesuwa i pomijasz wiersze.  For i = lastRow To 1 Step -1  ' Sprawdź, czy cały wiersz jest pusty (CountA liczy niepuste komórki)  If Application.WorksheetFunction.CountA(ActiveSheet.Rows(i)) = 0 Then  ActiveSheet.Rows(i).Delete ' Usuń pusty wiersz  licznikUsunietych = licznikUsunietych + 1  End If  Next i Application.ScreenUpdating = True ' Przywróć ekran  MsgBox "Usunięto " & licznikUsunietych & " pustych wierszy.", vbInformation, "Gotowe" End Sub 

' Makro 09: Czyszczenie danych — usuwanie zbędnych spacji i znaków specjalnych Sub Makro09_CzyscDane()  Dim ws As Worksheet  Dim zakres As Range  Dim komorka As Range  Dim wartoscOryg As String  Dim wartoscPo As String  Dim licznikZmian As Long Application.ScreenUpdating = False Set ws = ActiveSheet  ' Sprawdź, co użytkownik zaznaczył — jeśli nic, weź UsedRange (cały obszar danych)  If Selection.Cells.Count = 1 Then  Set zakres = ws.UsedRange  Else  Set zakres = Selection  End If licznikZmian = 0 For Each komorka In zakres  ' Przetwarzaj tylko komórki z tekstem (nie formuły, nie liczby)  If komorka.HasFormula = False And VarType(komorka.Value) = vbString Then  wartoscOryg = komorka.Value ' TRIM: usuwa spacje na początku i końcu oraz wielokrotne spacje wewnątrz  ' CLEAN: usuwa niedrukowane znaki (np. znaki nowej linii)  wartoscPo = Application.WorksheetFunction.Trim( _  Application.WorksheetFunction.Clean(wartoscOryg)) ' Zapisz zmienioną wartość tylko jeśli faktycznie jest różnica  If wartoscOryg <> wartoscPo Then  komorka.Value = wartoscPo  licznikZmian = licznikZmian + 1  End If  End If  Next komorka Application.ScreenUpdating = True  MsgBox "Oczyszczono " & licznikZmian & " komórek ze zbędnych spacji i znaków.", _  vbInformation, "Czyszczenie zakończone" End Sub 

' Makro 10: Konwersja formuł na wartości (zamrożenie wyników obliczeń) Sub Makro10_FormulaNaWartosc()  Dim zakres As Range ' Konwertuj tylko zaznaczony zakres lub cały UsedRange  If Selection.Cells.Count > 1 Then  Set zakres = Selection  Else  Set zakres = ActiveSheet.UsedRange  End If ' Kopiuj-wklej specjalnie: tylko wartości (usuwa formuły, zostawia wyniki)  zakres.Copy  zakres.PasteSpecial Paste:=xlPasteValues ' xlPasteValues = wklej tylko wartości Application.CutCopyMode = False ' Usuń migającą ramkę kopiowania MsgBox "Formuły zamienione na wartości w zakresie " & zakres.Address, _  vbInformation, "Konwersja zakończona" End Sub 

Kategoria 3: Zarządzanie arkuszami i plikami

' Makro 11: Tworzenie spisu treści z hiperłączami do wszystkich arkuszy Sub Makro11_SpisTresci()  Dim wsSpis As Worksheet ' arkusz ze spisem treści  Dim ws As Worksheet ' iterowany arkusz  Dim i As Long ' licznik wierszy  Const NAZWA_SPISU As String = "Spis Treści" Application.ScreenUpdating = False ' Usuń stary arkusz ze spisem jeśli istnieje  On Error Resume Next ' Ignoruj błąd jeśli arkusz nie istnieje  Application.DisplayAlerts = False ' Nie pytaj o potwierdzenie usunięcia  ThisWorkbook.Sheets(NAZWA_SPISU).Delete  Application.DisplayAlerts = True  On Error GoTo 0 ' Wznów normalną obsługę błędów ' Dodaj nowy arkusz spisu na pierwszą pozycję  Set wsSpis = ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(1))  wsSpis.Name = NAZWA_SPISU ' Nagłówek spisu treści  With wsSpis.Range("A1")  .Value = "Spis treści — " & ThisWorkbook.Name  .Font.Bold = True  .Font.Size = 14  End With  wsSpis.Range("A2").Value = "Kliknij nazwę arkusza, aby do niego przejść:" ' Dodaj hiperłącza do każdego arkusza (pomijając sam spis)  i = 4 ' Zacznij od wiersza 4 (2 wiersze na nagłówek + 1 pusty)  For Each ws In ThisWorkbook.Worksheets  If ws.Name <> NAZWA_SPISU Then  ' Dodaj hiperłącze: kliknięcie przenosi do arkusza ws, komórki A1  wsSpis.Hyperlinks.Add _  Anchor:=wsSpis.Cells(i, 1), _  Address:="", _  SubAddress:="'" & ws.Name & "'!A1", _  TextToDisplay:=ws.Name  i = i + 1  End If  Next ws wsSpis.Columns("A").AutoFit ' Dopasuj szerokość kolumny  Application.ScreenUpdating = True  MsgBox "Spis treści gotowy! Dodano " & (i - 4) & " hiperłączy.", vbInformation, "Gotowe" End Sub 

' Makro 12: Ochrona wszystkich arkuszy hasłem jednocześnie Sub Makro12_ChronWszystkieArkusze()  Dim ws As Worksheet  Dim haslo As String ' Poproś o hasło (InputBox zwraca pusty string jeśli kliknięto Anuluj)  haslo = InputBox("Podaj hasło do ochrony wszystkich arkuszy:" & vbCrLf & _  "(Uwaga: zapamiętaj hasło! Bez niego nie odblokujesz arkuszy)", _  "Ustaw hasło ochrony", "") If haslo = "" Then  MsgBox "Anulowano. Żaden arkusz nie został zabezpieczony.", vbInformation, "Anulowano"  Exit Sub ' Wyjdź z makra  End If ' Chroń każdy arkusz tym samym hasłem.  For Each ws In ThisWorkbook.Worksheets  ws.Protect Password:=haslo, _  DrawingObjects:=True, _  Contents:=True, _  Scenarios:=True  Next ws MsgBox "Wszystkie " & ThisWorkbook.Worksheets.Count & _  " arkusze zostały zabezpieczone hasłem.", vbInformation, "Ochrona włączona" End Sub 

' Makro 13: Zdejmowanie ochrony ze wszystkich arkuszy jednocześnie Sub Makro13_ZdejmijOchroneWszystkich()  Dim ws As Worksheet  Dim haslo As String  Dim bladHasla As Boolean haslo = InputBox("Podaj hasło, aby odblokować wszystkie arkusze:", "Zdejmij ochronę", "") If haslo = "" Then  MsgBox "Anulowano.", vbInformation, "Anulowano"  Exit Sub  End If bladHasla = False ' Próbuj odblokować każdy arkusz — obsłuż błąd jeśli hasło jest złe  For Each ws In ThisWorkbook.Worksheets  On Error Resume Next ' Ignoruj błąd złego hasła — złapiemy go ręcznie  ws.Unprotect Password:=haslo  If Err.Number <> 0 Then ' Błąd = złe hasło  bladHasla = True  Err.Clear  End If  On Error GoTo 0 ' Wróć do normalnej obsługi  Next ws If bladHasla Then  MsgBox "Błąd: Hasło nieprawidłowe dla jednego lub więcej arkuszy.", vbCritical, "Błąd hasła"  Else  MsgBox "Ochrona zdjęta ze wszystkich arkuszy.", vbInformation, "Gotowe"  End If End Sub 

' Makro 14: Zapisz aktywny arkusz jako PDF z datą w nazwie pliku Sub Makro14_EksportujDoPDF()  Dim ścieżkaPDF As String ' pełna ścieżka pliku PDF  Dim nazwaPliku As String ' nazwa pliku bez ścieżki  Dim folderDocelowy As String ' folder zapisu ' Folder docelowy: ten sam, co plik Excel lub Pulpit jeśli plik niezapisany  If ThisWorkbook.Path <> "" Then  folderDocelowy = ThisWorkbook.Path & " "  Else  folderDocelowy = Environ("USERPROFILE") & " Desktop " ' Pulpit użytkownika  End If ' Zbuduj nazwę pliku: NazwaArkusza_RRRR-MM-DD.pdf  nazwaPliku = ActiveSheet.Name & "_" & Format(Now(), "yyyy-mm-dd") & ".pdf"  ścieżkaPDF = folderDocelowy & nazwaPliku ' Eksportuj aktywny arkusz do PDF.  ActiveSheet.ExportAsFixedFormat _  Type:=xlTypePDF, _  Filename:=ścieżkaPDF, _  Quality:=xlQualityStandard, _  IncludeDocProperties:=True, _  IgnorePrintAreas:=False, _  OpenAfterPublish:=True MsgBox "PDF zapisany jako:" & vbCrLf & ścieżkaPDF, vbInformation, "Eksport zakończony" End Sub 

' Makro 15: Łączenie (konsolidacja) danych ze wszystkich arkuszy do jednego Sub Makro15_PolaczArkusze()  Dim wsZbiorczy As Worksheet ' arkusz docelowy  Dim ws As Worksheet ' iterowany arkusz źródłowy  Dim lastRowSrc As Long ' ostatni wiersz w arkuszu źródłowym  Dim lastRowDst As Long ' ostatni wiersz w arkuszu docelowym  Const NAZWA_ZBIORCZEGO As String = "KONSOLIDACJA" Application.ScreenUpdating = False  Application.Calculation = xlCalculationManual ' Wyłącz przeliczanie — szybciej ' Usuń stary arkusz zbiorczy jeśli istnieje  On Error Resume Next  Application.DisplayAlerts = False  ThisWorkbook.Sheets(NAZWA_ZBIORCZEGO).Delete  Application.DisplayAlerts = True  On Error GoTo 0 ' Dodaj nowy arkusz zbiorczy na końcu  Set wsZbiorczy = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))  wsZbiorczy.Name = NAZWA_ZBIORCZEGO lastRowDst = 1 ' Zacznij wklejanie od wiersza 1 arkusza zbiorczego For Each ws In ThisWorkbook.Worksheets  If ws.Name <> NAZWA_ZBIORCZEGO Then ' Pomiń arkusz zbiorczy  lastRowSrc = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row If lastRowSrc > 0 Then ' Kopiuj tylko jeśli arkusz ma dane  ' Skopiuj cały zakres danych (od A1 do ostatniego wiersza)  ws.Range("A1:A" & lastRowSrc).EntireRow.Copy  wsZbiorczy.Cells(lastRowDst, 1).PasteSpecial xlPasteValues  lastRowDst = lastRowDst + lastRowSrc ' Przesuń wskaźnik  End If  End If  Next ws Application.CutCopyMode = False  Application.Calculation = xlCalculationAutomatic ' Przywróć przeliczanie  Application.ScreenUpdating = True MsgBox "Konsolidacja zakończona. Dane z " & (ThisWorkbook.Sheets.Count - 1) & _  " arkuszy skopiowane do '" & NAZWA_ZBIORCZEGO & "'.", vbInformation, "Gotowe" End Sub 

Kategoria 4: Automatyzacja raportów

' Makro 16: Automatyczne wstawianie wiersza z sumami na końcu tabeli Sub Makro16_DodajWierszSum()  Dim ws As Worksheet  Dim lastRow As Long ' ostatni wiersz z danymi  Dim lastCol As Long ' ostatnia kolumna z danymi  Dim j As Long ' licznik kolumn Application.ScreenUpdating = False Set ws = ActiveSheet  ' Znajdź ostatni wiersz i kolumnę z danymi w obszarze roboczym  lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row  lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column ' Wiersz sum = jeden poniżej ostatniego wiersza danych  Dim wierszSum As Long  wierszSum = lastRow + 1 ' Wpisz etykietę "SUMA" w pierwszej kolumnie  ws.Cells(wierszSum, 1).Value = "SUMA"  ws.Cells(wierszSum, 1).Font.Bold = True ' Dla każdej kolumny (od 2 do ostatniej) wstaw formułę SUMA  For j = 2 To lastCol  ' Sprawdź, czy kolumna zawiera liczby (nie tekst)  If IsNumeric(ws.Cells(2, j).Value) Then  ' Wstaw formułę sumowania od wiersza 2 do lastRow  ws.Cells(wierszSum, j).Formula = "=SUM(" & _  ws.Cells(2, j).Address(True, False) & ":" & _  ws.Cells(lastRow, j).Address(True, False) & ")"  ws.Cells(wierszSum, j).Font.Bold = True  End If  Next j ' Sformatuj wiersz sum — gruba górna ramka  ws.Rows(wierszSum).Borders(xlEdgeTop).LineStyle = xlContinuous  ws.Rows(wierszSum).Borders(xlEdgeTop).Weight = xlMedium Application.ScreenUpdating = True  MsgBox "Wiersz sum dodany w wierszu " & wierszSum & ".", vbInformation, "Gotowe" End Sub 

' Makro 17: Rozdzielanie danych do osobnych arkuszy według wartości w kolumnie Sub Makro17_RozdzielDane()  Dim wsDane As Worksheet ' arkusz źródłowy z danymi  Dim wsDocel As Worksheet ' arkusz docelowy dla grupy  Dim slownik As Object ' słownik unikalnych wartości  Dim klucz As Variant ' klucz słownika (nazwa grupy)  Dim lastRow As Long ' ostatni wiersz danych  Dim i As Long ' licznik wierszy  Dim kolumnaGrup As Long ' numer kolumny z kategoriami  Dim wartoscKomorki As String  Dim lastRowDocel As Long Application.ScreenUpdating = False  Application.Calculation = xlCalculationManual Set wsDane = ActiveSheet  kolumnaGrup = 2 ' ZMIEŃ TEN NUMER: która kolumna zawiera kategorie? (B = 2, C = 3 itd.)  lastRow = wsDane.Cells(wsDane.Rows.Count, 1).End(xlUp).Row ' Zbierz unikalne wartości z kolumny grup (pomijając nagłówek w wierszu 1)  Set slownik = CreateObject("Scripting.Dictionary")  For i = 2 To lastRow  wartoscKomorki = CStr(wsDane.Cells(i, kolumnaGrup).Value)  If wartoscKomorki <> "" And Not slownik.Exists(wartoscKomorki) Then  slownik.Add wartoscKomorki, wartoscKomorki  End If  Next i ' Dla każdej unikalnej wartości — utwórz arkusz i skopiuj do niego odpowiednie wiersze  For Each klucz In slownik.Keys  ' Sprawdź czy arkusz o tej nazwie już istnieje  On Error Resume Next  Set wsDocel = ThisWorkbook.Sheets(CStr(klucz))  On Error GoTo 0 If wsDocel Is Nothing Then  ' Utwórz nowy arkusz  Set wsDocel = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))  wsDocel.Name = Left(CStr(klucz), 31) ' Max 31 znaków w nazwie arkusza!  ' Skopiuj wiersz nagłówka (wiersz 1)  wsDane.Rows(1).Copy wsDocel.Rows(1)  End If ' Skopiuj pasujące wiersze do arkusza docelowego  For i = 2 To lastRow  If CStr(wsDane.Cells(i, kolumnaGrup).Value) = CStr(klucz) Then  lastRowDocel = wsDocel.Cells(wsDocel.Rows.Count, 1).End(xlUp).Row + 1  wsDane.Rows(i).Copy wsDocel.Rows(lastRowDocel)  End If  Next i Set wsDocel = Nothing ' Wyzeruj zmienną obiektu dla następnej iteracji  Next klucz Application.Calculation = xlCalculationAutomatic  Application.ScreenUpdating = True  MsgBox "Dane rozdzielone do " & slownik.Count & " arkuszy według kolumny " & kolumnaGrup & ".", _  vbInformation, "Gotowe" End Sub 

' Makro 18: Automatyczne tworzenie tabeli przestawnej (Pivot Table) Sub Makro18_UtworzPivot()  Dim wsDane As Worksheet ' arkusz ze źródłem danych  Dim wsPivot As Worksheet ' arkusz z tabelą przestawną  Dim zakresDanych As String ' adres zakresu źródłowego  Dim pt As PivotTable ' obiekt tabeli przestawnej  Dim pc As PivotCache ' pamięć podręczna tabeli  Const NAZWA_PIVOT_SHEET As String = "Raport Pivot" Application.ScreenUpdating = False Set wsDane = ActiveSheet  ' Pobierz zakres danych (zakładamy, że dane zaczynają się od A1)  zakresDanych = wsDane.Name & "!" & wsDane.UsedRange.Address(True, True) ' Usuń stary arkusz pivot jeśli istnieje  On Error Resume Next  Application.DisplayAlerts = False  ThisWorkbook.Sheets(NAZWA_PIVOT_SHEET).Delete  Application.DisplayAlerts = True  On Error GoTo 0 ' Dodaj arkusz dla tabeli przestawnej  Set wsPivot = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))  wsPivot.Name = NAZWA_PIVOT_SHEET ' Utwórz pamięć podręczną (PivotCache) — punkt danych dla tabeli  Set pc = ThisWorkbook.PivotCaches.Create( _  SourceType:=xlDatabase, _  SourceData:=zakresDanych, _  Version:=xlPivotTableVersion15) ' xlPivotTableVersion15 = Excel 2013+ ' Utwórz tabelę przestawną w arkuszu wsPivot, od komórki A3  Set pt = pc.CreatePivotTable( _  TableDestination:=wsPivot.Range("A3"), _  TableName:="PivotRaport") ' Skonfiguruj pola tabeli — dostosuj nazwy kolumn do swoich danych!  ' UWAGA: "Kategoria" i "Wartość" to przykładowe nazwy kolumn z arkusza źródłowego  With pt  ' Pole wierszy — grupowanie (np. handlowiec, kategoria produktu)  On Error Resume Next ' Pomiń błąd jeśli kolumna o tej nazwie nie istnieje  .PivotFields("Kategoria").Orientation = xlRowField  .PivotFields("Kategoria").Position = 1 ' Pole wartości — co sumujemy?  .AddDataField .PivotFields("Wartość"), "Suma wartości", xlSum  On Error GoTo 0  End With Application.ScreenUpdating = True  MsgBox "Tabela przestawna utworzona w arkuszu '" & NAZWA_PIVOT_SHEET & "'." & vbCrLf & _  "Dostosuj pola w zakładce 'Lista pól przestawnych'.", vbInformation, "Gotowe" End Sub 

Kategoria 5: Operacje na plikach i folderach

' Makro 19: Masowe tworzenie folderów na podstawie listy w Excelu Sub Makro19_TworzFoldery()  Dim folderNadrzedny As String ' folder, w którym tworzymy podfoldery  Dim nazwaFoldera As String ' nazwa tworzonego podfolderu  Dim i As Long ' licznik wierszy  Dim lastRow As Long  Dim licznikUtworzone As Long ' Poproś użytkownika o wskazanie folderu nadrzędnego  folderNadrzedny = InputBox("Podaj pełną ścieżkę folderu nadrzędnego:" & vbCrLf & _  "Przykład: C: Projekty Klienci", _  "Tworzenie folderów", "C: ") If folderNadrzedny = "" Then Exit Sub ' Upewnij się, że ścieżka kończy się ukośnikiem  If Right(folderNadrzedny, 1) <> " " Then folderNadrzedny = folderNadrzedny & " " ' Sprawdź czy folder nadrzędny istnieje  If Dir(folderNadrzedny, vbDirectory) = "" Then  MsgBox "Folder nadrzędny nie istnieje: " & folderNadrzedny, vbCritical, "Błąd"  Exit Sub  End If lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row  licznikUtworzone = 0 ' Czytaj nazwy folderów z kolumny A (od wiersza 2, pomijając nagłówek)  For i = 2 To lastRow  nazwaFoldera = CStr(ActiveSheet.Cells(i, 1).Value) If nazwaFoldera <> "" Then  Dim pelnaSciezka As String  pelnaSciezka = folderNadrzedny & nazwaFoldera ' Utwórz folder tylko jeśli jeszcze nie istnieje  If Dir(pelnaSciezka, vbDirectory) = "" Then  MkDir pelnaSciezka ' VBA wbudowana funkcja tworzenia katalogu  ActiveSheet.Cells(i, 2).Value = "Utworzono" ' Zapisz status w kol. B  licznikUtworzone = licznikUtworzone + 1  Else  ActiveSheet.Cells(i, 2).Value = "Już istnieje" ' Folder już był  End If  End If  Next i MsgBox "Utworzono " & licznikUtworzone & " nowych folderów w:" & vbCrLf & folderNadrzedny, _  vbInformation, "Gotowe" End Sub 

' Makro 20: Pętla po wszystkich plikach Excel w folderze i zbieranie danych Sub Makro20_PetlaPoPlikach()  Dim folderSciezka As String ' ścieżka do przeszukiwanego folderu  Dim nazwaPliku As String ' nazwa aktualnie przetwarzanego pliku  Dim wbZewnetrzny As Workbook ' otwierany plik Excel  Dim wsZbior As Worksheet ' arkusz zbiorczy wyników  Dim wiersz As Long ' bieżący wiersz w arkuszu zbiorczym ' Wyświetl okno wyboru folderu  With Application.FileDialog(msoFileDialogFolderPicker)  .Title = "Wybierz folder z plikami Excel"  If .Show <> -1 Then Exit Sub ' Użytkownik anulował  folderSciezka = .SelectedItems(1) & " "  End With Application.ScreenUpdating = False  Application.DisplayAlerts = False ' Wyłącz alerty przy otwieraniu plików ' Przygotuj arkusz zbiorczy — użyj aktywnego arkusza  Set wsZbior = ActiveSheet  ' Dodaj nagłówki  wsZbior.Range("A1:C1").Value = Array("Nazwa pliku", "Arkusze", "Wartość A1 (Arkusz1)")  wsZbior.Range("A1:C1").Font.Bold = True  wiersz = 2 ' zacznij wpisywać od wiersza 2 ' Wyszukaj wszystkie pliki .xlsx i .xlsm w folderze  nazwaPliku = Dir(folderSciezka & "*.xls*") ' Gwiazdka pasuje do xlsx, xlsm, xlsb Do While nazwaPliku <> "" ' Pętla dopóki Dir() zwraca nazwy  On Error Resume Next ' Obsłuż błędy otwierania  ' Otwórz plik zewnętrzny bez makr, bez aktualizacji linków, tylko do odczytu  Set wbZewnetrzny = Workbooks.Open( _  Filename:=folderSciezka & nazwaPliku, _  UpdateLinks:=False, _  ReadOnly:=True, _  EnableMacros:=False) If Err.Number = 0 Then ' Jeśli otwarcie się powiodło  ' Zbierz dane: nazwa pliku, liczba arkuszy, wartość komórki A1 z pierwszego arkusza  wsZbior.Cells(wiersz, 1).Value = nazwaPliku  wsZbior.Cells(wiersz, 2).Value = wbZewnetrzny.Sheets.Count  wsZbior.Cells(wiersz, 3).Value = wbZewnetrzny.Sheets(1).Range("A1").Value  wiersz = wiersz + 1 wbZewnetrzny.Close SaveChanges:=False ' Zamknij bez zapisywania  End If  Err.Clear  On Error GoTo 0 nazwaPliku = Dir() ' Dir() bez argumentu = następny plik w katalogu  Loop wsZbior.Columns("A:C").AutoFit ' Dopasuj kolumny  Application.DisplayAlerts = True  Application.ScreenUpdating = True MsgBox "Przetworzono " & (wiersz - 2) & " plików z folderu:" & vbCrLf & folderSciezka, _  vbInformation, "Gotowe" End Sub 

' Makro 21: Importowanie danych z pliku CSV do aktywnego arkusza Sub Makro21_ImportCSV()  Dim ścieżkaCSV As String ' pełna ścieżka do pliku CSV  Dim numerPliku As Integer ' numer strumienia pliku (FreeFile)  Dim linia As String ' odczytana linia tekstu  Dim kolumny() As String ' tablica wartości po podziale linii  Dim wiersz As Long ' numer bieżącego wiersza w arkuszu  Dim j As Long ' licznik kolumn ' Okno wyboru pliku CSV  ścieżkaCSV = Application.GetOpenFilename( _  FileFilter:="Pliki CSV (*.csv),*.csv,Pliki tekstowe (*.txt),*.txt", _  Title:="Wybierz plik CSV do importu") If ścieżkaCSV = "False" Then Exit Sub ' Anulowano Application.ScreenUpdating = False ' Wyczyść aktywny arkusz przed importem  ActiveSheet.Cells.ClearContents ' Otwórz plik do odczytu  numerPliku = FreeFile() ' FreeFile() zwraca wolny numer strumienia  Open ścieżkaCSV For Input As #numerPliku wiersz = 1 ' zacznij od wiersza 1 Do While Not EOF(numerPliku) ' EOF = End Of File  Line Input #numerPliku, linia ' Odczytaj jedną linię tekstu ' Podziel linię po przecinku (CSV = Comma Separated Values)  ' UWAGA: dla polskich plików z średnikiem jako separatorem zamień "," na ";"  kolumny = Split(linia, ",") ' Wpisz każdą kolumnę do odpowiedniej komórki w bieżącym wierszu  For j = 0 To UBound(kolumny) ' UBound = ostatni indeks tablicy  ActiveSheet.Cells(wiersz, j + 1).Value = Trim(kolumny(j)) ' Trim usuwa spacje  Next j wiersz = wiersz + 1 ' Przejdź do następnego wiersza  Loop Close #numerPliku ' ZAWSZE zamknij plik po pracy! ActiveSheet.Columns.AutoFit ' Dopasuj szerokość kolumn  Application.ScreenUpdating = True MsgBox "Zaimportowano " & (wiersz - 1) & " wierszy z pliku CSV.", vbInformation, "Import zakończony" End Sub 

Kategoria 6: Integracja z Outlook i pobieranie danych zewnętrznych

' Makro 22: Wysyłanie emaila przez Microsoft Outlook z aktywnym arkuszem jako załącznik ' WYMAGANIE: Zainstalowany i skonfigurowany Outlook w tym samym systemie co Excel Sub Makro22_WyslijEmailOutlook()  Dim aplikacjaOutlook As Object ' obiekt aplikacji Outlook  Dim email As Object ' obiekt wiadomości MailItem  Dim ścieżkaZalacznika As String ' ścieżka do pliku PDF / Excel  Dim adresOdbiorcy As String  Dim tematWiadomosci As String  Dim trescWiadomosci As String ' Sprawdź czy plik został zapisany (potrzebujemy ścieżki do tworzenia załącznika)  If ThisWorkbook.Path = "" Then  MsgBox "Zapisz plik przed wysłaniem. Używamy jego kopii PDF jako załącznika.", _  vbExclamation, "Uwaga"  Exit Sub  End If ' Dane email — można dynamicznie pobierać z arkusza  adresOdbiorcy = InputBox("Adres e-mail odbiorcy:", "Wyślij raport", "")  If adresOdbiorcy = "" Then Exit Sub tematWiadomosci = "Raport: " & ActiveSheet.Name & " — " & Format(Now(), "yyyy-mm-dd")  trescWiadomosci = "Witaj," & vbCrLf & vbCrLf & _  "W załączeniu przesyłam raport: " & ActiveSheet.Name & "." & vbCrLf & _  "Data: " & Format(Now(), "dd.mm.yyyy HH:MM") & vbCrLf & vbCrLf & _  "Pozdrawiam" ' Najpierw wyeksportuj arkusz do PDF (żeby mieć plik do załączenia)  ścieżkaZalacznika = ThisWorkbook.Path & " " & ActiveSheet.Name & "_" & _  Format(Now(), "yyyymmdd") & ".pdf"  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ścieżkaZalacznika ' Utwórz obiekt Outlook (Late Binding — działa bez referencji do biblioteki)  Set aplikacjaOutlook = CreateObject("Outlook.Application")  Set email = aplikacjaOutlook.CreateItem(0) ' 0 = olMailItem (wiadomość e-mail) ' Skonfiguruj wiadomość  With email  .To = adresOdbiorcy  .Subject = tematWiadomosci  .Body = trescWiadomosci  .Attachments.Add ścieżkaZalacznika ' Dodaj PDF jako załącznik  .Display ' Pokaż wiadomość w Outlooku zamiast wysyłać automatycznie  ' Zamień .Display na .Send jeśli chcesz wysyłać bez podglądu!  End With MsgBox "Wiadomość przygotowana w Outlooku. Sprawdź i kliknij Wyślij.", _  vbInformation, "Email gotowy" ' Zwolnij obiekty COM  Set email = Nothing  Set aplikacjaOutlook = Nothing End Sub 

' Makro 23: Pobieranie aktualnego kursu walut z API NBP (JSON via XMLHTTP) Sub Makro23_KursWalutNBP()  Dim http As Object ' obiekt żądania HTTP  Dim url As String ' URL do API NBP  Dim odpowiedz As String ' surowa odpowiedź JSON  Dim kursStr As String ' kurs jako tekst  Dim kurs As Double ' kurs jako liczba  Dim waluta As String ' Pobierz kod waluty od użytkownika (np. EUR, USD, GBP, CHF)  waluta = UCase(InputBox("Podaj kod waluty (np. EUR, USD, GBP, CHF):", _ "Kurs NBP", "EUR"))  If waluta = "" Then Exit Sub ' URL API NBP: https://api.nbp.pl/api/exchangerates/rates/a/{waluta}/?format=json  url = "https://api.nbp.pl/api/exchangerates/rates/a/" & waluta & "/?format=json" ' Utwórz obiekt XMLHTTP (Late Binding)  Set http = CreateObject("MSXML2.XMLHTTP") On Error GoTo BladAPI ' Wykonaj synchroniczne żądanie GET  http.Open "GET", url, False ' False = synchroniczne (czekaj na odpowiedź)  http.Send  ' Wyślij żądanie If http.Status = 200 Then ' 200 = OK (sukces HTTP)  odpowiedz = http.ResponseText ' Pobierz treść odpowiedzi ' Proste wyodrębnienie kursu z JSON-a (szukamy "mid":)  ' Bardziej zaawansowane parsowanie JSON wymaga biblioteki lub regex  Dim pozycja As Long  pozycja = InStr(odpowiedz, """mid"":")  If pozycja > 0 Then  kursStr = Mid(odpowiedz, pozycja + 7, 8) ' Pobierz 8 znaków po "mid":  kursStr = Left(kursStr, InStr(kursStr, "}") - 1) ' Utnij po pierwszym }  kursStr = Trim(Replace(kursStr, ",", ".")) ' Zamień przecinek na kropkę  kurs = CDbl(kursStr) ' Konwertuj na liczbę Double ' Wpisz kurs do aktywnej komórki  ActiveCell.Value = kurs  ActiveCell.NumberFormat = "0.0000" ' 4 miejsca po przecinku MsgBox "Kurs " & waluta & "/PLN z NBP: " & Format(kurs, "0.0000") & " PLN" & vbCrLf & _  "Wpisano do komórki: " & ActiveCell.Address, vbInformation, "Kurs NBP"  Else  MsgBox "Nie można odczytać kursu z odpowiedzi API.", vbExclamation, "Błąd parsowania"  End If  Else  MsgBox "Błąd API NBP. Kod HTTP: " & http.Status & vbCrLf & _  "Sprawdź czy kod waluty jest poprawny: " & waluta, vbCritical, "Błąd HTTP"  End If Set http = Nothing ' Zwolnij obiekt  Exit Sub  BladAPI:  MsgBox "Błąd połączenia z API NBP." & vbCrLf & _  "Sprawdź połączenie internetowe." & vbCrLf & _  "Kod błędu: " & Err.Number & " — " & Err.Description, vbCritical, "Błąd połączenia"  Set http = Nothing End Sub 

Kategoria 7: Zaawansowane narzędzia i event handling

' Makro 24: Logowanie zmian w komórkach do arkusza historii (Event Handling) ' UWAGA: To makro umieść w module ARKUSZA (nie w module ogólnym), np. kliknij prawym ' na nazwę arkusza w Project Explorer → View Code → wklej tam ten kod Private Sub Worksheet_Change(ByVal Target As Range)  ' Target = komórka (lub zakres), która właśnie zmieniła wartość Dim wsHistoria As Worksheet ' arkusz z historią zmian  Dim lastRow As Long ' ostatni wiersz w historii  Dim nazwaUzytkownika As String ' Ignoruj zmiany w całym arkuszu lub dla komórek w obszarze historii (pętla)  If Target.Cells.Count > 10 Then Exit Sub ' Zbyt duże zaznaczenie — pomiń ' Spróbuj uzyskać lub stworzyć arkusz historii  On Error Resume Next  Set wsHistoria = ThisWorkbook.Sheets("Historia zmian")  On Error GoTo 0 If wsHistoria Is Nothing Then  Set wsHistoria = ThisWorkbook.Sheets.Add  wsHistoria.Name = "Historia zmian"  ' Nagłówki kolumn historii  wsHistoria.Range("A1:E1").Value = Array("Data i godzina", "Użytkownik", "Arkusz", "Komórka", "Nowa wartość")  wsHistoria.Range("A1:E1").Font.Bold = True  End If ' Pobierz nazwę zalogowanego użytkownika Windows  nazwaUzytkownika = Environ("USERNAME") ' Wyłącz obsługę zdarzeń żeby uniknąć nieskończonej pętli  Application.EnableEvents = False lastRow = wsHistoria.Cells(wsHistoria.Rows.Count, "A").End(xlUp).Row + 1 ' Iteruj po każdej zmienionej komórce (może być kilka naraz)  Dim komorka As Range  For Each komorka In Target.Cells  wsHistoria.Cells(lastRow, 1).Value = Now() ' Znacznik czasu  wsHistoria.Cells(lastRow, 1).NumberFormat = "dd.mm.yyyy hh:mm:ss"  wsHistoria.Cells(lastRow, 2).Value = nazwaUzytkownika ' Użytkownik  wsHistoria.Cells(lastRow, 3).Value = Me.Name ' Nazwa arkusza (Me = bieżący arkusz)  wsHistoria.Cells(lastRow, 4).Value = komorka.Address(False, False) ' Adres komórki np. B5  wsHistoria.Cells(lastRow, 5).Value = komorka.Value ' Nowa wartość  lastRow = lastRow + 1  Next komorka ' Przywróć obsługę zdarzeń  Application.EnableEvents = True End Sub 

' Makro 25: Przycisk "Resetuj wszystkie filtry" — jednym kliknięciem przywróć pełny widok Sub Makro25_ResetujFiltry()  Dim ws As Worksheet  Dim lt As ListObject ' obiekt tabeli Excel (Table/ListObject) Application.ScreenUpdating = False Set ws = ActiveSheet ' METODA 1: Usuń AutoFilter jeśli jest aktywny na zwykłym zakresie  If ws.AutoFilterMode Then  ' ShowAllData wyłącza filtrowanie ale zostawia strzałki  If ws.FilterMode Then ws.ShowAllData  End If ' METODA 2: Wyczyść filtry we wszystkich tabelach Excel (ListObjects) na arkuszu  For Each lt In ws.ListObjects  If Not lt.AutoFilter Is Nothing Then  lt.AutoFilter.ShowAllData ' Pokaż wszystkie wiersze tabeli  End If  Next lt ' METODA 3: Usuń filtr grupowania (jeśli dane były pogrupowane)  On Error Resume Next  ws.Cells.Rows.Hidden = False ' Odkryj wszystkie ukryte wiersze  ws.Cells.Columns.Hidden = False ' Odkryj wszystkie ukryte kolumny  On Error GoTo 0 Application.ScreenUpdating = True ' Powiadom użytkownika  MsgBox "Wszystkie filtry zostały zresetowane. Widoczne są wszystkie dane.", _  vbInformation, "Filtry wyczyszczone" End Sub 

Podsumowanie — od czego zacząć naukę Excel VBA?

Masz teraz w rękach kompletny excel vba tutorial po polsku — od konfiguracji środowiska przez typy danych, instrukcje warunkowe, pętle i obsługę błędów, aż po 25 gotowych makr z pełnym, skomentowanym kodem.

Pamiętaj: VBA działa wyłącznie w desktopowej wersji Excela. Jeśli korzystasz ze starego pakietu biurowego, czas na upgrade. Microsoft Office 2024 Professional Plus i Office 2024 Standard dostępne są w konkurencyjnych cenach w sklepie kluczesoft.pl — zarówno jako licencje wieczyste, jak i w ramach subskrypcji Microsoft 365. Inwestycja w licencję zwróci się już po kilku godzinach zaoszczędzonych dzięki automatyzacji VBA.