Sub proba()
Dim wsCopy As Worksheet
Dim rngCopy As Range
Dim wbPaste As Workbook
Dim wsPaste As Worksheet
Dim rngPaste As Range
aktivniList = ActiveSheet.Name
ChDir ActiveWorkbook.Path 'odredivanje direktorija u kojem se nalazi excel datoteka sa procedurom
FileToOpen = Application.GetOpenFilename _
(Title:="izaberi datoteku za uvoz podataka", _
FileFilter:="prihvacene extenzije *.xls (*.xlsm),")
If FileToOpen = False Then
'ako datoteka nije izabrana
MsgBox "Nije izabrana datoteka.", vbExclamation, "ERROR"
Exit Sub
Else
'ako je datoteka izabrana
imeFajla = GetFilenameFromPath(FileToOpen) 'ime datoteke koju smo uzeli
Set wbPaste = ActiveWorkbook
Set wbCopy = Workbooks.Open(FileToOpen)
Set wsCopy = wbCopy.Worksheets("Sheet1")
zadnjiRed = traziZadnjiRed("Sheet1", 1)
zadnjaKolona = traziZadnjuKolonu("Sheet1")
Set rngCopy = wsCopy.Range(Cells(1, 1), Cells(zadnjiRed, zadnjaKolona))
Set wsPaste = wbPaste.Worksheets(aktivniList) 'shit u koji idu podaci
Set rngPaste = wsPaste.Range("A1") 'pocinje od celije A1
rngCopy.Copy
rngPaste.PasteSpecial
Workbooks.Application.CutCopyMode = False
Filename = ActiveWorkbook.Name
Workbooks(Filename).Close
End If
End Sub
Function traziZadnjiRed(ImeSita As String, kolona)
Dim Zadnji As Long
Dim ws As Worksheet
Set ws = Sheets(ImeSita)
With ws
Zadnji = .Cells(.Rows.Count, kolona).End(xlUp).Row
End With
traziZadnjiRed = Zadnji
End Function
Function traziZadnjuKolonu(ImeSita As String)
Dim Zadnji As Long
Dim ws As Worksheet
Dim zadnjaCelija As Range
Set ws = Sheets(ImeSita)
Set zadnjaCelija = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, MatchCase:=False)
Zadnji = zadnjaCelija.Column
traziZadnjuKolonu = Zadnji
End Function
Function GetFilenameFromPath(ByVal strPath As String) As String
' npr. 'c:\winnt\win.ini' vraca 'win.ini'
If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
End If
End Function