Ú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.

• #26182 Louro őstag alevan #26181

  Új Válasz 2015-03-23 20:51:38 #26182

  Ú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

  

  Louro

  őstag

  válasz alevan #26181 üzenetére

  Szia,

  egy gyors, esti fusimunka, de hátha használható. Ha nem megy a makrózás, akkor bocsi. Feltételezek egy kisebb hozzáértést Főleg az adatmásolásnál lehet hasznos, bár pici logikával hamar megvan, hogy hogyan lehet A-ból B-be másolgatni.

  A lentit direkt úgy csináltam, hogy a forrásokat kimented egy mappába, így az eredetik érintetlenek maradnak. A fájlokat át se kell nevezni. A lényeg, hogy .xlsx legyen a kiterjesztésük. Azokat mind bedolgozza.

  SUB fajlfeldolgozo()
  
  'A Master.xlsx legyen az asztalon.
  'A forrásfájlokat másold az Asztal/Forrás mappába ;)
  'Így nem kell aggódni, ha 1001 forrás van.
  
  Dim Filename, Pathname As String
  Dim SourceWorkbook As Workbook
  Dim LeadFinalMsgBox As Boolean
  
  'Hol vannak a fájlok
  Pathname = ActiveWorkbook.Path & "\Forrás\"
  'Ha régi formátumban vannak, akkor .xls-re írd át.
  Filename = Dir(Pathname & "*.xlsx")
  
  'Menjen végig minden fájlon
  Do While Len(Filename) > 0
  'Megnyitni a forrást
  Workbooks.Open(Filename)
  
  'Itt jön a másolgatás.
  Range("B2").Select
  Selection.Copy
  Workbooks("Master.xlsx").Worksheets("Sheet1").Range(Cells(ActiveSheet.Usedrange.Rows.Count,1)).PasteSpecial xlPasteValues
  
  Range("C8").Select
  Selection.Copy
  Workbooks("Master.xlsx").Worksheets("Sheet1").Range(Cells(ActiveSheet.Usedrange.Rows.Count,2)).PasteSpecial xlPasteValues
  
  'itt akár elegánsan ciklussal is meglehetne csinálni.
  
  'Forrásfájl törlése
  Kill Pathname & Filename
  
  'Hol vannak a fájlok
  Filename = Dir(Pathname & "*.xlsx")
  
  Loop
  
  End SUB

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