Code:
Sub NisuStigle()
Dim Bazna As Workbook
Dim Otvorena As Workbook
Dim i As Long
Dim j As Long
Dim Putanja As String
Putanja = ThisWorkbook.Path
j = 1
n = 1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = Putanja
.Filename = "*" & ".xls"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Bazna = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set Otvorena = Workbooks.Open(.FoundFiles(i))
Otvorena.Worksheets("Nisu Stigle").Unprotect
Otvorena.Worksheets("Nisu Stigle").Range("e1").Copy
Bazna.Activate
Cells(j, 2).PasteSpecial
j = j + 1
Otvorena.Worksheets("Nisu Stigle").Activate
Range(Cells(10, 2), Cells(19, 5)).Copy
Bazna.Activate
Cells(j, 1).PasteSpecial
Otvorena.Close savechanges:=False
j = j + 10
Next i
End If
End With
Bazna.Activate
Rows.RowHeight = 30
End Sub
Sub NisuStigle()
Dim Bazna As Workbook
Dim Otvorena As Workbook
Dim i As Long
Dim j As Long
Dim Putanja As String
Putanja = ThisWorkbook.Path
j = 1
n = 1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = Putanja
.Filename = "*" & ".xls"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Bazna = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set Otvorena = Workbooks.Open(.FoundFiles(i))
Otvorena.Worksheets("Nisu Stigle").Unprotect
Otvorena.Worksheets("Nisu Stigle").Range("e1").Copy
Bazna.Activate
Cells(j, 2).PasteSpecial
j = j + 1
Otvorena.Worksheets("Nisu Stigle").Activate
Range(Cells(10, 2), Cells(19, 5)).Copy
Bazna.Activate
Cells(j, 1).PasteSpecial
Otvorena.Close savechanges:=False
j = j + 10
Next i
End If
End With
Bazna.Activate
Rows.RowHeight = 30
End Sub
.::. http://www.mixi.co.sr .::.