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

• #24898 Fferi50 Topikgazda air #24896

  Új Válasz 2015-01-06 23:53:28 #24898

  Ú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

  

  Fferi50

  Topikgazda

  válasz air #24896 üzenetére

  Szia!

  Próbáld ki a következőt:
  Sub osszerako()
  Dim hova As Worksheet, fajlneve As String, usor As Long, xx As Integer
  Set hova = ActiveSheet
  fajlneve = Dir("*.xls*")
  Application.EnableEvents = False
  Do While fajlneve <> ""
  xx = xx + 1
  usor = hova.UsedRange.Rows.Count + 1: If usor = 2 Then usor = 1
  Workbooks.Open Filename:=fajlneve, ReadOnly:=True
  ActiveSheet.UsedRange.Copy Destination:=hova.Cells(usor, 1)
  ActiveWorkbook.Close False
  fajlneve = Dir()
  If xx Mod 10 = 0 Then Application.StatusBar = "Másolva: " & xx & "db fájl!"
  Loop
  Application.EnableEvents = True
  Application.StatusBar = False
  MsgBox "A másolásnak vége, kérem, mentse el a fájlt!", vbInformation, "Fájlok összemásolása"
  End Sub

  Remélem segít.

  Üdv.

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