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

• #11092 Delila_1 veterán fokukac #11091

  Új Válasz 2011-08-16 16:21:36 #11092

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

  Add meg, melyik cellákat kell a füzetekből egybe gyűjteni, és mi legyen a helyük a gyűjtő füzetben.

• #11090 Delila_1 veterán fokukac #11089

  Új Válasz 2011-08-16 14:37:48 #11090

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

  Ez a makró a gyűjtő füzetből indítva a megadott útvonalú könyvtár xls fájljait egyenként behívja, és az A2:D_utolsó_sor tartományukban lévő adatokat egymás alá bemásolja a gyűjtő füzetbe.

  Sub Osszevon()
  Const utvonal = "D:\valami\" 'Itt írd át az útvonalat
  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 'Behívott füzet alsó sora
  Range(Cells(2, 1), Cells(usor, 4)).Copy 'A2:Dvalahány tartomány másolása
  
  ActiveWindow.ActivateNext
  gy_usor = Range("A65536").End(xlUp).Row + 1 'Gyüjtő füzet alsó sora
  Cells(gy_usor, 1).Select
  ActiveSheet.Paste 'Beillesztés
  
  ActiveWindow.ActivatePrevious 'Behívott füzet
  ActiveWindow.Close 'Bezárás
  End If
  FN = Dir()
  Loop Until FN = ""
  End Sub

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