' makro kopira višestruku selekciju
'
Sub KopirajMultiBlok()

Dim SpremanNiz() As Range
Dim CiljnaAdresa As Range
Dim GornjiLevi As Range
Dim BrojNizova As Integer, i As Integer
Dim PrviRed As Long, LevaKolona As Integer
Dim RedOdst As Long, KolOdst As Integer
Dim BrojCelija As Integer

' Prekidaj ako nije odabran blok
If TypeName(Selection) <> "Range" Then
    MsgBox "Odaberite blok za kopiranje. Dopuštena je i višestruka selekcija."
    Exit Sub
End If

' Snimi nizove kao posebne objekte
BrojNizova = Selection.Areas.Count
ReDim SpremanNiz(1 To BrojNizova)
For i = 1 To BrojNizova
    Set SpremanNiz(i) = Selection.Areas(i)
Next

' odredi gornju levu ćeliju višestruke selekcije
PrviRed = ActiveSheet.Rows.Count
LevaKolona = ActiveSheet.Columns.Count
For i = 1 To BrojNizova
    If SpremanNiz(i).Row < PrviRed Then PrviRed = SpremanNiz(i).Row
    If SpremanNiz(i).Column < LevaKolona Then LevaKolona = SpremanNiz(i).Column
Next
Set GornjiLevi = Cells(PrviRed, LevaKolona)

' Uzmi ciljnu adresu
On Error Resume Next
Set CiljnaAdresa = Application.InputBox (Prompt:="Unesite _
    ili označite adresu gornje leve ćelije ciljnog opsega:", _
    Title:="Kopiranje višestruke selekcije", Type:=8)
On Error GoTo 0
' Exit if canceled
If TypeName(CiljnaAdresa) <> "Range" Then Exit Sub

' Provera da je opseg referenciran kao jedna ćelija
Set CiljnaAdresa = CiljnaAdresa.Range("A1")

' provera ciljnog opsega za postojeće podatke
BrojCelija = 0

For i = 1 To BrojNizova
    RedOdst = SpremanNiz(i).Row - PrviRed
    KolOdst = SpremanNiz(i).Column - LevaKolona
    BrojCelija = BrojCelija + _
        Application.CountA(Range(CiljnaAdresa.Offset(RedOdst, KolOdst), _
        CiljnaAdresa.Offset(RedOdst + SpremanNiz(i).Rows.Count - 1, _
        KolOdst + SpremanNiz(i).Columns.Count - 1)))
Next i

' Upozori korisnika ako ciljni opseg nije prazan
If BrojCelija <> 0 Then _
    If MsgBox("Da li želite da prepišete postojeće podatke?",_
        vbQuestion + vbYesNo, _
        "Kopiranje višestruke selekcije") <> vbYes Then Exit Sub

' Copy and paste each area
' Upisivanje selekcije
For i = 1 To BrojNizova
    RedOdst = SpremanNiz(i).Row - PrviRed
    KolOdst = SpremanNiz(i).Column - LevaKolona
    SpremanNiz(i).Copy CiljnaAdresa.Offset(RedOdst, KolOdst)
Next i

End Sub