Dakujem Lugr funguje len este sa mi to nedadari dostat do povodneho makra vies mi s tym este pomoct .Dakujem
Sub Import()
Dim CESTA As String
Dim SOUBOR As String
Dim ZDROJ As String
Dim CIL As String
Dim RADEK As Long
Dim POCET As Long
Dim wsDATA As Worksheet
Set wsDATA = Worksheets("List1")
POCET = wsDATA.Cells(Rows.Count, "A").End(xlUp).Row
If POCET > 0 Then wsDATA.Range("A2").Resize(POCET, 3).ClearContents
MESIC = wsDATA.Range("E1")
CILMESIC = Sheets("Report").Range("B1")
CESTA = "C:\Users\ASUS PC\Documents\MEGA\import\Report"
ZDROJ = "Report " & MESIC & ".xlsx"
CIL = "Vyučtovanie " & CILMESIC & ".xlsm"
SOUBOR = CESTA & ZDROJ
If Dir(SOUBOR) = "" Then MsgBox "Soubor " & SOUBOR & " neexistuje!", vbCritical: Exit Sub
Application.ScreenUpdating = False
Workbooks.Open Filename:=SOUBOR
POCET = Workbooks(ZDROJ).Sheets("Položky dokladu").Cells(Rows.Count, "A").End(xlUp).Row - 2
Workbooks(CIL).Sheets("List1").Range("A2").Resize(POCET, 3).Value = Workbooks(ZDROJ).Sheets("Položky dokladu").Range("B3").Resize(POCET, 3).Value
Workbooks(ZDROJ).Close SaveChanges:=False
Application.ScreenUpdating = True
ActiveWorkbook.RefreshAll
End Sub
citovat