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

• #29753 Zimmy88 tag Delila_1 #29751

  Új Válasz 2015-12-08 15:57:24 #29753

  Ú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

  

  Zimmy88

  tag

  válasz Delila_1 #29751 üzenetére

  Szia!

  Köszi a tippet! Kipróbáltam, és lefuttattam a következő makrót. Viszont két dolog kellene még bele:
  az egyik, hogy először kijelölje azokat a munkalapokat, amin végre kell hajtani a műveletet (B1 cella ha adott szöveget (pl "ezkell") tartalmaz, csak akkor kell rögzíteni az értékeket és különmenteni a fájlt),
  a másik, pedig hogy értékrögzítés után, kimentés előtt ki kellene törölni pár felesleges oszlopot az E és a W közül (oszlop sorszámát tudom megadni).
  Más: elég lassan futott a makró, 18-20 másodpercig tartott, mire "kidobott" egy kész munkalapot külön fájlba. Mivel lehetne gyorsítani esetleg? 30-40 munkalapnál ez elég hosszú idő...

  Sub mm()
  Dim lap As Integer, r As Range, nev As String, utvonal As String
  Dim terulet As Range
  
  utvonal = "D:\kiment\"
  
  For lap = 1 To Worksheets.Count
  Sheets(lap).Select
  Set terulet = Range("E8:W9,E12:W14,E16:W17,E20:W22,E25:W30,E33:W35,E37:W39,E41:W43,E45:W46,E49:W50,E52:W59,E62:W67,E69:W72,E75:W76,E81:W82,E85:W90,E93:W95,E98:W100,E102:W103,E105:W105,E107:W109,E112:W117,E120:W120,E123:W124,E129:W130,E132:W132")
  For Each r In terulet
  Range(r.Address) = r.Value
  Next
  nev = ActiveSheet.Name
  ActiveSheet.Copy
  ActiveWorkbook.SaveAs Filename:=utvonal & nev & ".xlsx"
  ActiveWindow.Close
  Next
  End Sub

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