Excel – kopiowanie obszaru o zmiennym zakresie
Jak napisac makro, które umoźliwi kopiowanie niepustych wierszy zakładając, źe obszar składa sie ze stałej ilości kolumn, a ilośc wypełnionych wierszy ulega zmianie.
Uźycie CurrentRegion niestety nie jest moźliwe, układ danych wyklucza oddzielenie zakresu pustymi polami. Bardzo proszę o pomoc.
Uźycie CurrentRegion niestety nie jest moźliwe, układ danych wyklucza oddzielenie zakresu pustymi polami. Bardzo proszę o pomoc.
Odpowiedzi: 4
wiesz lustrzany Rycho, to działa tak jak trzeba :lol:, serdeczne dzięki, naprawdę pomogłeś
Witaj.
Z reguły w makro nie trzeba zaznaczać obiektu (w tym wypadku Range), by dokonać na nim operacji (kopiować, zmieniac itp.).
Kopiowanie Twojego zakresu moźe wyglądać tak:
(kod, mniej więcej taki, jak tworzy rejestrator makra)
ale najprościej zrobić to jedną instrukcją:
Z reguły w makro nie trzeba zaznaczać obiektu (w tym wypadku Range), by dokonać na nim operacji (kopiować, zmieniac itp.).
Kopiowanie Twojego zakresu moźe wyglądać tak:
(kod, mniej więcej taki, jak tworzy rejestrator makra)
w = Range("B" & Rows.Count).End(xlUp).Row
'lub uźyj powyźszej funkcji, jeśli ilość danych w kolumnach moźe być róźna
Range("B24:S24").Resize(w – 24 + 1).Select
Selection.Copy
Worksheets("Arkusz2").Select
Range("D8").Select
ActiveSheet.Paste
ale najprościej zrobić to jedną instrukcją:
w = Range("B" & Rows.Count).End(xlUp).Row
Range("B24:S24").Resize(w – 24 + 1).Copy Worksheets("Arkusz2").Range("D8")
-
<P>hej</P> <P>a jak napisac makro aby skopiowane arkusze ( powiedzmy ze bedzie ich 3 ) mozna by wkleic jedno pod drugim np do Arkusz2. Mam na mysli 3 arkusze ( Arkusz1,Arkusz3,Arkusz4) ktore maja zmienne zakresy danych( tak jak w przykladzie powyzej) wkleic jedno pod drugim bez wiersza odstepu do Arkusz2</P> <P>dzieki za odpowiedz </P> <P>pozdrawiam</P>
no nieźle(thx), tylko jak teraz poradzic sobie z tematem zaznaczenia obszaru do kopiowania wiedząc źe poczatek zakresu jest stały: B24 do S24 a ostatni wiersz wskazany przez powyźsze makro ?
Witaj.
Ostatni wiersz danych:
Ostatni wiersz danych:
Sub test()
Dim a As String, w As Long
a = "A"
w = Range(a & Rows.Count).End(xlUp).Row
MsgBox "Ostatni wiersz w kolumnie " & a & " = " & w
a = "A:D"
w = Ostatni_Wiersz_w_Kolumnach(a)
MsgBox "Ostatni wiersz w kolumnach " & a & " = " & w
End Sub
Function Ostatni_Wiersz_w_Kolumnach(kolumny As String) As Long
Dim w As Long, K As Range
w = 0
For Each K In Intersect(Rows(Rows.Count), Columns(kolumny))
w = WorksheetFunction.Max(w, K.End(xlUp).Row)
Next
Ostatni_Wiersz_w_Kolumnach = w
End Function
Strona 1 / 1