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

• #3415 Delila_1 veterán mimi_bacsi #3414

  Új Válasz 2008-04-01 19:47:28 #3415

  Ú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

  

  Delila_1

  veterán

  válasz mimi_bacsi #3414 üzenetére

  Tedd egy külön mappába az xls-eket, amiket össze akarsz fésülni
  Vegyél egy új füzetet, az első sorba másold át a címsort. Másold be a scriptet, mentsd el a fájlt Gyűjtő néven, de másik könyvtárba.
  Írd át az útvonalat, és a Range(Cells(2,1), Cells(usor,4)).Copy sorban írd át a 4-et annyira, ahány oszlopod van az összefésülendő fájlokban. A 4-es a D oszlopot jelenti.
  A script egyenként behívja a mappában lévő fájlokat, az adatokat egymás alá beilleszti a Gyűjtő füzetbe, bezárja a behívott füzetet. Az összegyűjtött adatokat a végén kedved szerint rendezheted.

  Sub Fésü()
  Const utvonal = "E:\Eadat\Új mappa\" 'Ezt írd át arra a mappára, ahol az xls-eid vannak
  Dim FN As String, WB As Workbook
  
  ChDir utvonal
  FN = Dir(utvonal & "*.xls", vbNormal)
  Do
  If FN <> "." And FN <> ".." Then
  Workbooks.Open Filename:=FN
  usor = Range("A65536").End(xlUp).Row + 1 'Behívott füzet alsó sora
  
  Windows("Gyűjtő.xls").Activate
  gy_usor = Range("A65536").End(xlUp).Row + 1 'Gyűjtő füzet alsó sora
  
  Windows(FN).Activate 'Behívott füzet
  Range(Cells(2, 1), Cells(usor, 4)).Copy 'A:D oszlop (1:4)
  
  Windows("Gyűjtő.xls").Activate 'Gyűjtő füzet
  Cells(gy_usor, 1).Select
  ActiveSheet.Paste
  Windows(FN).Activate 'Behívott füzet
  
  ActiveWorkbook.Save
  ActiveWindow.Close
  End If
  FN = Dir()
  Loop Until FN = ""
  End Sub

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