Skopiuj zakres z większą liczbą obszarów do określonego arkusza za pomocą VBA w programie Microsoft Excel

Anonim

W tym artykule stworzymy makro do połączenia wielu obszarów w określonym arkuszu.

Surowe dane składają się z niektórych przykładowych danych, w tym imienia i wieku. Mamy dwa obszary, które zawierają surowe dane. Chcemy połączenia obu obszarów w arkuszu „Destination”.

Kliknięcie przycisku „Kopiuj rekord” spowoduje połączenie danych z obu obszarów wraz z formatowaniem.

Kliknięcie przycisku „Kopiuj tylko wartość” spowoduje również połączenie danych z obu obszarów, ale bez kopiowania formatu komórki.

Wyjaśnienie kodu

Dla każdego małego rozmiaru w arkuszach("Główny").Zakres("A9:B13,D16:E20").Obszary

Następna Smallrng

Powyższa pętla For Each służy do wykonywania pętli na określonych obszarach.

Ustaw DestRange = Sheets("Miejsce docelowe").Range("A" i LastRow)

Powyższy kod służy do utworzenia obiektu zakresu ostatniej komórki, do której chcemy skopiować dane.

Smallrng.Copy DestRange

Powyższy kod służy do kopiowania danych do określonego miejsca docelowego.

Proszę postępować zgodnie z poniższym kodem!

 Option Explicit Sub CopyMultiArea() 'Deklarowanie zmiennych Dim DestRange As Range Dim Smallrng As Range Dim LastRow As Long 'Przechodzenie w pętlę przez określone obszary For Each Smallrng In Sheets("Main").Range("A9:B13,D16:E20"). Obszary 'Znajdowanie numeru wiersza ostatniej komórki LastRow = Sheets("Miejsce docelowe").Range("A1").SpecialCells(xlLastCell).Row + 1 'Wybieranie komórki, do której rekordy mają być skopiowane If LastRow = 2 Następnie ustaw DestRange = Sheets("Destination").Range("A" & LastRow - 1) Else Set DestRange = Sheets("Destination").Range("A" & LastRow) End If 'Kopiowanie rekordów do określonego zakresu docelowego Smallrng.Copy DestRange Next Smallrng End Sub Sub CopyMultiAreaValues() 'Deklarowanie zmiennych Dim DestRange As Range Dim Smallrng As Range Dim LastRow As Long 'Zapętlanie przez określone obszary dla każdego mniejszego w arkuszach("Main").Range("A9:B13,D16:E20" ).Areas 'Znajdowanie numeru wiersza ostatniej komórki LastRow = Sheets("Miejsce docelowe").Range("A1").SpecialCells(xlLastCell).Row + 1 With Smallrng 'Wybieranie komórki, w której ponownie przewody muszą być skopiowane If LastRow = 2 Then Set DestRange = Sheets("Destination").Range("A" & LastRow - 1).Resize(.Rows.Count, .Columns.Count) Else Set DestRange = Sheets(" Destination").Range("A" & LastRow).Resize(.Rows.Count, .Columns.Count) End If End With 'Przypisywanie wartości ze źródła do miejsca docelowego DestRange.Value = Smallrng.Value Next Smallrng 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