VBATools

Powielanie zaznaczonych wierszy

by on Sep.26, 2011, under Excel, Porady

Procedura realizuje kopiowanie zaznaczonych wierszy w ilości podanej w komunikacie inputbox wywołane po jej uruchomieniu. Skopiowane wiersze znajdować się będą pod spodem wolnego dla arkusza zakresu.

Option Explicit

Sub Kopiuj_zaznaczone_wiersze()
Dim x&, y&, i&, max_row&, max_kol&, ile, zakres As Range
'MVP OShon from VBATools.pl
ile = InputBox("Ile razy chcesz powielić zaznaczone wiersze?", _
 "Kopiowanie danych", 1)
If IsNumeric(ile) = False Then Exit Sub
On Error GoTo blad
For y = 1 To Cells(1, 1).SpecialCells(xlLastCell).Column
 i = Last(Columns(y))
 If max_kol < i Then max_kol = y
Next y

With Application
 .ScreenUpdating = False
 .EnableEvents = False
 Set zakres = Selection
 zakres.Copy
 For x = 1 To ile
 max_row = Cells(Rows.Count, max_kol).End(xlUp).Row + 1
 Range("A" & max_row).PasteSpecial Paste:=xlWhole
 Next x
 .CutCopyMode = False
 .EnableEvents = True
 .ScreenUpdating = True
End With
Set zakres = Nothing
Exit Sub
blad:
MsgBox Err.Number & vbCr & Err.Description, vbExclamation, "VBATools.pl"
If Not zakres Is Nothing Then Set zakres = Nothing
End Sub

Function Last(rng As Excel.Range) As Long
' wg. Ron de Bruin, 20 Feb 2007
' http://www.rondebruin.nl/last.htm
 On Error Resume Next
 Last = rng.Find(What:="*", _
 After:=rng.Cells(1), _
 LookAt:=xlPart, _
 LookIn:=xlFormulas, _
 SearchOrder:=xlByRows, _
 SearchDirection:=xlPrevious, _
 MatchCase:=False).Row
 On Error GoTo 0
End Function

Makro to przydaje się w przypadku kiedy mamy opracowany szablon, który należy zwielokrotnić w obrębie jednego arkusza lub jego formatowanie, formuły musiały by być kopiowane XXX razy.

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.

:, , , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of Anorak
Profile picture of marcinmachalowski
Profile picture of Joanna Subik
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała