W tym artykule stworzymy makro do dzielenia danych według określonej liczby wierszy.
Surowe dane mamy w arkuszu „RawData”. Chcemy podzielić te dane na wiele arkuszy.
Przed uruchomieniem makra musimy określić liczbę wierszy wymaganych w każdym arkuszu.
Wyjaśnienie kodu
CntRows = Cint(Arkusze("Main").TextBox1.Value)
Powyższy kod służy do uzyskania liczby arkuszy wymaganych w arkuszu.
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Powyższy kod służy do uzyskania numeru wiersza ostatniej komórki.
Arkusze.Dodaj po:=Arkusze(Arkusze.Liczba)
Powyższy kod służy do dodania nowego arkusza po ostatnim arkuszu.
.Range("A" & n).Resize(CntRows, LastColumn).Copy Range("A1")
Powyższy kod służy do kopiowania określonej liczby wierszy do nowego arkusza roboczego.
Proszę postępować zgodnie z poniższym kodem!
Option Explicit Sub SplitDataToMultipleSheets() 'Deklarowanie zmiennych Dim LastRow As Long, n As Long, CntRows As Long Dim LastColumn As Integer 'Pobieranie liczby wierszy wymaganych w jednym arkuszu CntRows = CInt(Sheets("Main").TextBox1.Value ) 'Wyłączanie aktualizacji ekranu Application.ScreenUpdating = False With Sheets("RawData") 'Pobieranie numeru wiersza i numeru kolumny ostatniej komórki LastRow = .Range("A" & .Rows.Count).End(xlUp).Row LastColumn = .Range("A1").SpecialCells(xlCellTypeLastCell).Column 'Przewijanie danych w arkuszu For n = 1 To LastRow Step CntRows 'Dodawanie nowego arkusza roboczego Sheets.Add after:=Sheets(Sheets.Count) 'Kopiowanie danych do nowego worksheet .Range("A" & n).Resize(CntRows, LastColumn).Copy Range("A1") Next n .Activate End With 'Włączanie aktualizacji ekranu 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
