W tym artykule napiszemy makro (VBA), które skopiuje wybrany rekord tabeli do odpowiedniego arkusza. Arkusz docelowy wybierzemy z listy rozwijanej. 

Dane będziemy wpisywać do tabeli w arkuszu Dane: 

Formatka

Po wyborze nazwy arkusza z listy rozwijanej będziemy uruchamiać makro, które skopiuje dane z wiersza aktywnej komórki, do wybranego z listy arkusza. Makro będziemy uruchamiać za pomocą przycisku.

1. Założenia makra

Zanim przejdziemy do pisania makra, zastanówmy się nad założeniami. Są one takie:

1. Nazwy arkuszy są identyczne do wpisów na liście rozwijanej
2. Makro będzie uruchamiane za pomocą przycisku w arkuszu, a którym jest tabela z danymi do kopiowania
3. Kopiowane będą dane z trzech pierwszych kolumn (A:C) z wiersza, w którym jest aktywna komórka
4. Tabele, do których wklejamy dane, są identyczne w każdym arkuszu

2. Logika makra

Nasze makro potrzebuje dwóch prostych informacji: jaki jest zakres źródłowy do kopiowania i jaki jest zakres docelowy, czyli ten, do którego kopiujemy dane.

Trochę o tych zakresach wiemy dzięki naszym założeniom: na pewno będą znajdować się w kolumnach A:C. Pozostaje tylko kwestia określenia wiersza:

• W przypadku zakresu źródłowego będzie to wiersz aktywnej komórki.
• W przypadku zakresu docelowego, będzie to kolejny wiersz pod tabelą. Zatem jeśli poznamy liczbę wierszy tabeli, to wiersz docelowy będzie o jeden większy.

Będzie nam jeszcze potrzebna nazwa arkusza, do którego mają trafić dane. Jego nazwa znajduje się w kolumnie D, w tym samym wierszu co pozostałe dane do kopiowania.

Jak już to wiemy, to możemy zabierać się do pisania kodu!

3. Treść kodu makra

Przejdź do edytora Visual Basica za pomocą skrótu klawiszowego Alt + F11.

Następnie utwórz nowy moduł (Insert/Module).

Wpisz nazwę procedury DodajRekord:

Sub DodajRekord()

End Sub

Na początek zdefiniujemy zmienne, których za chwilę użyjemy:

Sub DodajRekord() 

    Dim KomZrodlowa As Range, ZakresZrodlowy As Range 

    Dim Zestawienie As String, ArkZestawienia As Worksheet 

    Dim ZakresDocelowy As Range, WierszDocelowy As Long 

End Sub 

KOMÓRKA I ZAKRES ŹRÓDŁOWY

Teraz przyszedł czas na określenie komórki źródłowej – będzie to po prostu komórka aktywna. Ja jednak lubię ją definiować jako zmienną obiektową, dlatego napiszę tak:

    Set KomZrodlowa = ActiveCell 

OK. To teraz czas na określenie zakresu źródłowego. Na pewno zacznie się w kolumnie A i skończy w kolumnie C. Wierszem natomiast będzie wiersz komórki źródłowej – skorzystam tutaj z jej właściwości Row:

Set ZakresZrodlowy = Range("A" & KomZrodlowa.Row, "C" & KomZrodlowa.Row)

NAZWA ARKUSZA DOCELOWEGO

Teraz kolej na nazwę arkusza docelowego, który w moim przykładzie jest nazwą zestawienia. Tak też nazwę sobie zmienną, która będzie przechowywała jego nazwę:

Zestawienie = Cells(KomZrodlowa.Row, 4).Value

I teraz pora na określenie arkusza docelowego. Będzie to element klasy Worksheets o nazwie, którą obecnie przechowuje już zmienna Zestawienie:

Set ArkZestawienia = Worksheets(Zestawienie)

To teraz już tylko zakres docelowy przed nami.

WIERSZ I ZAKRES DOCELOWY

Wiadomo, że zakres docelowy będzie znajdował się w kolumnach A:C. Nie znamy tylko wiersza, zatem od niego zacznijmy. Jak już wspominałam wcześniej, będzie to kolejny wiersz po tabeli, zawierającej dotychczasowe dane w arkuszu docelowym. Te dane zawsze zaczynają się od komórki A1, więc z powodzeniem mogę użyć CurrentRegion:

WierszDocelowy = ArkZestawienia.Range("A1").CurrentRegion.Rows.Count + 1

Gdy znamy wiersz, określenie zakresu docelowego to już pikuś:

Set ZakresDocelowy = ArkZestawienia.Range("A" & WierszDocelowy, "C" & WierszDocelowy)

Teraz pozostaje już nam tylko skopiowanie danych. Skopiowanie, a w zasadzie przepisanie, ponieważ technicznie niczego nie będę tutaj kopiować. Powiem jedynie, że wartość zakresu docelowego ma być taka sama, jak zakresu źródłowego. Oczywiście, w każdym arkuszu docelowym (odpowiednich zestawień), warto określić formaty liczbowe, np. daty czy liczb, aby zachować ładny i czytelny wygląd danych:

ZakresDocelowy.Value = ZakresZrodlowy.Value

Cały kod wygląda następująco:

Sub DodajRekord() 

    Dim KomZrodlowa As Range, ZakresZrodlowy As Range 

    Dim Zestawienie As String, ArkZestawienia As Worksheet 

    Dim ZakresDocelowy As Range, WierszDocelowy As Long 

     

    Set KomZrodlowa = ActiveCell 

        Set ZakresZrodlowy = Range("A" & KomZrodlowa.Row, "C" & KomZrodlowa.Row) 

     

    Zestawienie = Cells(KomZrodlowa.Row, 4).Value 

        Set ArkZestawienia = Worksheets(Zestawienie) 

         

    WierszDocelowy = ArkZestawienia.Range("A1").CurrentRegion.Rows.Count + 1 

        Set ZakresDocelowy = ArkZestawienia.Range("A" & WierszDocelowy, "C" & WierszDocelowy) 

     

    ZakresDocelowy.Value = ZakresZrodlowy.Value 

End Sub 

Tadam! Tyle! Mam nadzieję, że Ci się to przyda 😊. A jeśli chcesz się nauczyć samodzielnie pisać takie cuda, to rozważ zapisanie się na mój kurs o pisaniu makr od podstaw „Excel w codziennej pracy cz. 3.”. Więcej informacji znajdziesz pod wspomnianym przed chwilą linkiem. 

Plik do pobrania:

https://malinowyexcel.pl/wp-content/uploads/2024/02/MalinowyExcel-20240220-VBA-Wpisy-kategorii-na-arkusze-DW.zip

I film na Youtubie, gdzie pokazuję powyższe rozwiązanie: