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

• #32089 Delila_1 veterán merkucyo #32088

  Új Válasz 2016-07-17 16:48:19 #32089

  Ú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 merkucyo #32088 üzenetére

  Az elsőben, ahova már beírtad a képleteket, másold be a makrót egy modulba.
  A többi 9 fájlt másold át egy új mappába, legyen ez a "C:\aaa\"

  A WS.Range("B10:H100").Copy FN.Sheets("Munka1").Range("B10") sorban írd át a másolandó képletek helyét, ami itt a B10:H100 tartomány.
  A sor első fele WS.Range("B10:H100").Copy adja a másolandó tartományt, a második rész, FN.Sheets("Munka1").Range("B10") pedig azt, hogy a megnyitott füzetben hova másoljon. Itt csak a terület bal felső cellájának a helyét kell megadni.

  A makró egyenként megnyitja a 9 fájlt, elvégzi a másolást, menti és bezárja a megnyitott füzetet.
  Ha rendesen összejött, visszamásolhatod a 9 fájlt az eredeti helyükre.

  Sub Masolas()
Dim FN, WS As Worksheet
Const utvonal = "C:\aaa\"
Set WS = ActiveWorkbook.Sheets("Munka1")

Application.ScreenUpdating = False 'Képernyőfrissítés letiltása
ChDir utvonal 'Direktor váltás
FN = Dir(utvonal & "*.xlsx")
Do
If FN <> "." And FN <> ".." Then
Workbooks.Open Filename:=utvonal & FN 'megnyitja a fájlt
WS.Range("B10:H100").Copy FN.Sheets("Munka1").Range("B10") 'másolás az elsőből a megnyitottba
Workbooks(FN).Save 'megnyitott mentése
Workbooks(FN).Close 'megnyitott bezárása
End If
FN = Dir()
Loop Until FN = ""
Application.ScreenUpdating = True 'Képernyőfrissítés engedélyezése
End Sub

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