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

• #39570 Delila_1 veterán lorcsi #39569

  Új Válasz 2018-11-08 14:38:10 #39570

  Ú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 lorcsi #39569 üzenetére

  Sub Szetcincal()
Dim sor As Long, WS As Worksheet, utvonal As String
utvonal = ThisWorkbook.Path & "\"

Application.ScreenUpdating = False

Set WS = ActiveSheet
sor = 2
Do While Cells(sor, 1) <> ""
Sheets(Array("Munka2", "Munka3", "Munka4", "Munka5", "Munka6", "Munka7", "Munka8", _
"Munka9", "Munka10", "Munka11", "Munka12")).Copy '***
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = "Munka1" '*****
WS.Rows(1).Copy ActiveWorkbook.Sheets(1).Cells(1)
WS.Rows(sor).Copy ActiveWorkbook.Sheets(1).Cells(2, 1)
ActiveWorkbook.SaveAs utvonal & sor - 1 & ". füzet.xlsx"

ActiveWorkbook.Close
sor = sor + 1
Loop

Application.ScreenUpdating = True
End Sub

  A 3 csillaggal jelzett sorban írd át a "Munka2", "Munka3" ... "Munka12" neveket a saját lapjaid nevére..
  Az 5 csillagos sorban a "Munka1" helyére írd be a szétszedendő lapod nevét.

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