Czasami kopiowanie danych z wielu arkuszy dla tej samej kolumny staje się rutynową pracą. Tego kroku można uniknąć dzięki automatyzacji. Jeśli chcesz stworzyć skonsolidowany arkusz po skopiowaniu danych z kolumny każdego arkusza do jednego arkusza, powinieneś przeczytać ten artykuł.
W tym artykule stworzymy makro do kopiowania danych z określonej kolumny i wklejania do nowego arkusza.
Surowe dane dla tego przykładu składają się z danych pracowników w postaci skoroszytu programu Excel zawierającego trzy arkusze z danymi działu, danymi osobowymi i danymi kontaktowymi pracowników.
Aby skopiować dane z różnych arkuszy do nowego arkusza, stworzyliśmy makro „CopyColumns”. To makro można uruchomić, klikając przycisk „Uruchom makro” na arkuszu „Główne”.
Makro „CopyColumns” wstawi nowy arkusz o nazwie „Master” po arkuszu „Main”. Arkusz „Master” będzie zawierał skonsolidowane dane ze wszystkich arkuszy.
Wyjaśnienie kodu
Worksheets.Add(after:=Worksheets("Main"))
Powyższy kod służy do wstawiania nowych arkuszy roboczych po arkuszu „Głównym”.
Jeśli Source.Name "Master" i Source.Name "Main" Wtedy
Zakończ, jeśli
Powyższy kod służy do ograniczenia kopiowania danych z arkusza „Master” i „Main”.
Źródło.UsedRange.Kopiuj Miejsce docelowe.Kolumny(Ostatnie)
Powyższy kod służy do kopiowania danych z arkusza źródłowego do arkusza docelowego.
Dla każdego źródła w ThisWorkbook.Worksheets
If Source.Name = "Master" Then
MsgBox "Karta wzorcowa już istnieje"
Wyjście Sub
Zakończ, jeśli
Następny
Powyższy kod służy do sprawdzenia, czy arkusz „wzorcowy” już istnieje w skoroszycie. Makro zatrzyma wykonywanie, jeśli arkusz „wzorcowy” już istnieje w skoroszycie.
Proszę postępować zgodnie z poniższym kodem!
Option Explicit Sub CopyColumns() Dim Source As Worksheet Dim Destination As Worksheet Dim Last As Long Application.ScreenUpdating = False 'Sprawdzanie, czy arkusz „główny” już istnieje w skoroszycie Dla każdego źródła w ThisWorkbook.Worksheets If Source.Name = "Master" Then MsgBox "Arkusz wzorcowy już istnieje" Exit Sub End If Next 'Wstawianie nowych arkuszy do skoroszytu Set Destination = Worksheets.Add(after:=Worksheets("Main")) 'Zmienianie nazwy arkusza Destination.Name = "Master" 'Pętla przez arkusze w skoroszycie Dla każdego źródła w tym skoroszycie. Arkusze If Source.Name "Master" And Source.Name "Main" Then 'Znajdowanie ostatniej kolumny w arkuszu docelowym Last = Destination.Range("A1").SpecialCells( xlCellTypeLastCell).Column If Last = 1 Then 'Wklejanie danych w arkuszu docelowym Source.UsedRange.Copy Destination.Columns(Last) Else Source.UsedRange.Copy Destination.Columns(Last + 1) End If End If Next Columns.AutoFit Application.ScreenUpdating = True End Sub
Jeśli podobał Ci się ten blog, podziel się nim ze znajomymi na Facebooku. Możesz również śledzić nas na Twitterze i Facebooku.
Chcielibyśmy usłyszeć od Ciebie, daj nam znać, jak możemy poprawić naszą pracę i uczynić ją lepszą dla Ciebie. Napisz do nas na stronie e-mail