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

• #45623 Delila_1 veterán sopruk #45622

  Új Válasz 2020-12-29 16:38:28 #45623

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

  Írtam rá egy nyúlfarknyi makrót.
  A füzetet, amiben a makró van, Összesítő.xlsm-nek neveztem el. Ha nálad nem ez a neve, az 5 csillaggal jelzett sorban írd át!
  Ha nem akarod az előző adatokat törölni, a sok csillagos két sort töröld.
  Modulba tedd, ahogy a Téma összefoglalóban olvashatod.

  Sub Osszemasolas()
Dim WB As Workbook, ide As Integer, FN
Set WB = ActiveWorkbook
Const utvonal = "C:\Kivonatok\"

'Előző adatok törlése *************
WB.Sheets(1).Range("A1").CurrentRegion.Offset(1).ClearContents' *************

Application.DisplayAlerts = False
Application.ScreenUpdating = False

ChDir utvonal
FN = Dir(utvonal & "*.xls*", vbNormal)
Do
If FN <> "." And FN <> ".." And FN <> "Összesítő.xlsm" Then '*****
ide = WB.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
Workbooks.Open Filename:=utvonal & FN
Sheets(1).Range("A1").CurrentRegion.Offset(1).Copy WB.Sheets(1).Range("A" & ide)
ActiveWindow.Close
End If
FN = Dir()
Loop Until FN = ""
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

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