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

• #39554 Delila_1 veterán lorcsi #39552

  Új Válasz 2018-11-07 07:46:48 #39554

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

  A lenti makrót másold a szétszedendő füzetedben egy modulba (lásd a téma összefoglalót). Állj arra a lapra, amit külön füzetekbe akarsz másolni, majd indítsd a makrót.

  Ha nem jó az új füzetek elnevezése (1.füzet.xlsx, 2.füzet.xlsx, stb.), az
  ActiveWorkbook.SaveAs utvonal & sor - 1 & ". füzet.xlsx"
  soron kell változtatni.

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

Set WS = ActiveSheet
sor = 2
Do While Cells(sor, 1) <> ""
Workbooks.Add
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
End Sub

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