VBATools

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