Excel Vyřešeno

[kulenka]

Poradí někdo makro nebo jiný postup jak zautomatizovat, aby se do jednoho excelovského souboru kopírovaly listy z jiných souborů.

Předem moc děkuji

[Reklama]

[PavelKilleR]

v exelu umim dobre ale asi sem nepochopil tu otazku zkus mi to nejak popsat

[kulenka]

Mám 5 excelovských souborů a přemýšlím, zda by šlo zajistit, aby se mi jednotlivé listy ze 4 excelovských souborů zobrazovaly v jednom.

Např.
Soubor1.xls obsahuje listy s názvy: přehled, sumář
Soubor2.xls obsahuje list s názvy: celkem, společné
Soubor3.xls obsahuje listy s názvy: skupina, celek, souhrn
Soubor4.xls obsahuje listy s názvy: přehledy, kolektivy

Je možné, aby se do Souboru5.xls přenesly listy sumář, společné, skupina a kolektivy?

[PavelKilleR]

na 1000% to jde ale bohuzel jsem asi tupek musel bych to mit zapli ten excel ja ted formatoval takze nemam nic nainstalovany to se neda rict z hlavy musim to videt vis jak ale pokusim se na to prijit

[navstevnik]

predpoklad: sesit Soubor5.xls obsahuje listy sumář, společné, skupina a kolektivy
v sesitu Soubor5.xls v editoru VBA vlozit do modulu nasledujici procedury, volat klavesovou zkratkou:

Kód: Vybrat vše

Option Explicit
Dim OK As Boolean
Dim SesitData As Workbook, ListData As Worksheet
Sub Aktualizovat()
Dim List As Worksheet, Sesit As Workbook, Cesta As String
Dim Soubor, SouborList, i As Integer
  Set Sesit = ActiveWorkbook
  Cesta = "D:\data\excel\"
  Soubor = Array("Soubor1.xls", "Soubor2.xls", "Soubor3.xls", "Soubor4.xls") ' seznam cest a souboru
  SouborList = Array("sumář", "společné","skupina","kolektivy") ' seznam listu
  'otevrit sesit a list
  i = 0
  Do
    Set List = Sesit.Worksheets(SouborList(i))
    Call OtevritSoubor(Cesta & Soubor(i), SouborList(i))
    If Not OK Then Exit Sub
    List.Range(ListData.UsedRange.Address).Value = ListData.UsedRange.Value
    SesitData.Close
    i = i + 1
  Loop While i < 4
End Sub

Sub OtevritSoubor(ByVal CestaSoubor As String, ByVal List As String)
Dim MsgTit As String, MsgResponse As String
  MsgTit = "Nacist"
  On Error GoTo Err1
  Set SesitData = Workbooks.Open(CestaSoubor)
  On Error GoTo Err2
  Set ListData = SesitData.Worksheets(List)
  On Error GoTo 0
  OK = True
  Exit Sub
Err1:
  MsgResponse = MsgBox("Soubor " & CestaSoubor & " nelze nalézt," & vbCrLf _
    & " zkontrolujte jeho název a umístìní v adresáøi!", vbOKOnly + vbCritical, MsgTit)
    OK = False
  Exit Sub
Err2:
  MsgResponse = MsgBox("List " & List & " v souboru " & CestaSoubor & vbCrLf _
    & " nelze nalézt, zkontrolujte jeho název!", vbOKOnly + vbCritical, MsgTit)
  SesitData.Close
  OK = False
End Sub

[kulenka]

Moc děkuji za napsání proceduru. Mohu ještě poprosit o pomoc, jak vyvolat tu proceduru? Předem moc děkuji

[navstevnik]

Nejjednodussi je pouzit klavesovou zkratku: Nastroje>Makro>Makra>vybrat prislusne makro>Moznosti>Klavesova zkratka (Ctrl+.. nebo CTRL+Shift+...). V Excelu 2007 je to trochu odlisne.
Dale je mozno vlozit na list ovladaci prvek Prikazove tlacitko a v udalostni procedure CommandButton1_Click() volat subrutinu.
Jinak lze subrutinu spustit v editoru VBA.