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

• #24903 Fferi50 Topikgazda air #24901

  Új Válasz 2015-01-07 07:50:03 #24903

  Ú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 #24901 üzenetére

  Szia!

  Elnavigálsz abba a könyvtárba, ahol a fájljaid vannak.
  Elindítod az excelt, ami egy új munkafüzettel indít.
  Ide összemásolhatod a fájlokat.
  Ezután Alt+F11 lenyomásával átmész a VBA project ablakba.
  A menüből kiválasztod az insert, azon belül pedig a module pontot.
  A megnyilt modullapra bemásolod az alábbi kódot:
  Sub osszerako()
  Dim hova As Worksheet, fajlneve As String, usor As Long, xx As Integer
  Set hova = ActiveSheet
  fajlneve = Dir("*.xls*")
  Application.EnableEvents = False
  Applicaton.ScreenUpdating=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.ScreenUpdating=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

  Visszamész az excel munkalapra (Alt+F11 ismét).
  Ezután menü - nézet- makrók megjelenítése. Megjelenik a listában az osszerako. Inditás.
  Alul a státusz soron fogod látni a begyűjtött fájlok számát, tizesével nőve.

  Ha végzett, kapsz egy üzenetet.
  Ezután mentés másként művelettel nevezd el a fájlodat, a mentés után bezárhatod.

  Remélem, sikerülni fog.

  Üdv.

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