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

• #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