Új hozzászólás Aktív témák

• #41559 Sutyi73 csendes tag

  Új Válasz 2019-08-12 16:51:41 #41559

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Sutyi73

  csendes tag

  Üdv!
  Eddig eljutottam, de nem jól működik. Mi lehet a hiba? A másolt adatokat szépen egymás alá kellene folyamatosan írnia, de nem úgy csinálja.

  Sub Munka1()
  Dim wb As Workbook
  Set wb = ActiveWorkbook
  Dim directory As String, fileName As String, sheet As Worksheet
  directory = "D:\2019.08\"
  fileName = Dir(directory & "*.xlsx")
  Do While fileName <> ""
  Workbooks.Open fileName:=directory & fileName, ReadOnly:=True
  Range("A2:E" & ActiveSheet.UsedRange.Rows.Count).Copy
  Destination = wb.Worksheets("Célmunkalap").Range("A" & wb.Worksheets("Célmunkalap").UsedRange.Rows.Count + 1)
  Windows("Órák.xlsm").Activate
  Range("A" & wb.Worksheets("Célmunkalap").UsedRange.Rows.Count + 1).Select
  ActiveSheet.Paste
  Workbooks(fileName).Close
  fileName = Dir()
  Loop
  End Sub

Új hozzászólás Aktív témák