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

• #26183 Fferi50 Topikgazda alevan #26181

  Új Válasz 2015-03-23 22:15:47 #26183

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

  Szia!

  A következő megoldást javaslom:

  Sub fajlmasolo()
  ' A makró legyen a Master fileban, amit makróbarát fájlként kell a művelet elindítása előtt elmenteni!
  ' Így a Master.xlsm legyen a forrásfájlokkal egy mappában, ez a mappa mindegy, hogy hol van!.
  
  Dim Filename As String, Pathname As String,xx as Double
  Activesheet.Usedrange.Clear ' a munkalap tartalmát kitöröljük
  'Hol vannak a fájlok
  Pathname = ActiveWorkbook.Path
  Filename = Dir(Pathname & "*.xlsx") 'Ha régi formátumban vannak, akkor .xls-re írd át.
  xx = 1 'ez az első fájl helye - az első oszlop
  'Menjen végig minden fájlon
  Do While Len(Filename) > 0
  'NEM KELL Megnyitni a forrást!!!
  Cells(1, xx).Formula = "='[" & Filename & "]Sheet1'!B2" 'Sheet1 helyére azt a munkalapnevet kell írnod, ahol az adatok vannak a forrásfájlban.
  Cells(2, xx).Formula = "='[" & Filename & "]Sheet1'!C8"
  Cells(3, xx).Formula = "='[" & Filename & "]Sheet1'!B15"
  ' itt folytatod a kitöltést a fentiek szerint
  xx = xx + 1 ' vesszük a következő oszlopba
  Filename = Dir() 'a következő fájlt
  Loop
  ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value ' a képleteket átváltjuk értékre
  MsgBox "A másolásnak vége!", vbInformation
  End Sub

  Makrót az Alt+F11 után "feltűnő" VBA ablakba tudsz másolni. A menüből ki kell választanod az Insert - Module opciót. Ezután tudod a modulba bemásolni.

  A forrásfájlokat utána kitörölheted - vagy az újakkal felülírhatod és ismételten lefuttatod a makrót.

  Üdv.

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