Prikazi cijelu temu 07.02.2017 21:57
dex Van mreze
Super Moderator
Registrovan od:23.02.2012
Lokacija:Knjazevac


Predmet:Re: Excel kopiranje listova iz Knjiga2, Knjiga3, Knjiga4.. u Knjiga1
Ovo kod mene radi
importuje sve neprazne sheetove iz direktorijuma gde je smesten fajl
radi za xls fajlove
trebalo bi dodati petlju da to jos jednom uradi za xlsx, xlsm, eventualno csv ili sta vec

PreuzmiIzvorni kôd (Visual Basic):
  1. Private Sub CommandButton2_Click()
  2. On Error GoTo Error_Handler
  3.    
  4.     Dim putanja As String
  5.     Dim Fajl As String
  6.     Dim kriterija As String
  7.     Dim puninaziv As String
  8.     Dim book As Workbook
  9.    
  10.     Application.ScreenUpdating = False
  11.     kriterija = "xls"   ' za xls (excel 2003 i nize fajlove)
  12.    putanja = Application.ThisWorkbook.Path 'nalazi tekuci direktorijum
  13.     puninaziv = putanja & "\*." & kriterija
  14.     Fajl = dir(puninaziv)
  15.         Do While Fajl <> vbNullString
  16.             If Fajl <> "." And Fajl <> ".." And Fajl <> Application.ThisWorkbook.Name Then ' da ne importuje tekuci fajl
  17.          
  18.                 Set book = Workbooks.Open(Fajl, True, True)
  19.                     For Each tabla In book.Sheets
  20.                     If tabla.UsedRange.Cells.Count > 1 Then ' da li i sheetu ima podataka
  21.                        tabla.Copy after:=Sheet1
  22.                     End If
  23.                 Next tabla
  24.  
  25.                 book.Close
  26.                  
  27.             End If
  28.             Fajl = dir
  29.         Loop
  30.         Application.ScreenUpdating = True
  31.        
  32. Error_Handler_Exit:
  33.     On Error Resume Next
  34.     Exit Sub
  35. Error_Handler:
  36.     MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
  37.             "Error Number: " & Err.Number & vbCrLf & _
  38.             "Error Source: DirFajl" & vbCrLf & _
  39.             "Error Description: " & Err.Description, _
  40.             vbCritical, "An Error has Occured!"
  41.     Resume Error_Handler_Exit
  42. End Sub