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

• #20387 Delila_1 veterán psg5 #20383

  Új Válasz 2014-02-10 11:51:41 #20387

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

  A lenti makróval megoldható.
  A Const utvonal = "C:\Temp\" sort írd át a saját mentési útvonaladra.

  A makrót arról a lapról kell indítanod, ahol a másolandó sorok vannak. Az utvonal változóba beírt mappába menti a fájlokat, mindegyiket azon a néven, ahányadik sorban megtalálta az adatokat.
  Gondolom, fejléc is van a lapodon, ezért minden új füzet első sora a fejléc lesz, második pedig a kiválasztott adatsor. Addig fut a makró, míg az A oszlopban talál adatot.

  Sub UjFuzetek()
  Dim sor As Long, WB As Workbook, WSE As Worksheet, WSM As Worksheet
  Const utvonal = "C:\Temp\"
  Application.ScreenUpdating = False
  
  Set WB = Workbooks(ActiveWorkbook.Name)
  Set WSE = WB.Sheets("Munka1")
  sor = 2
  
  Do While Cells(sor, "A") <> ""
  Workbooks.Add
  Set WSM = ActiveWorkbook.Sheets("Munka1")
  WSE.Rows(1).Copy WSM.Range("A1")
  WSE.Rows(sor).Copy WSM.Range("A2")
  ActiveWorkbook.SaveAs Filename:=utvonal & sor & ".xlsx"
  ActiveWorkbook.Close
  sor = sor + 1
  Loop
  
  Application.ScreenUpdating = True
  MsgBox "Kész van a soronkénti mentés", vbOKOnly + vbInformation
  End Sub

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