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

• #8668 m.zmrzlina senior tag iwu #8661

  Új Válasz 2010-11-17 21:37:00 #8668

  Ú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

  

  m.zmrzlina

  senior tag

  válasz iwu #8661 üzenetére

  Nekem ezt sikerült kiötleni:

  Sub valogat()
  Dim sorsz As Integer
  Dim holavege As Integer
  
  Sheets("Munka1").Select
  Cells(Rows.Count, 1).End(xlUp).Select
  holavege = ActiveCell.Row
  
  For sorsz = 1 To holavege - 1
  
  Sheets.Add After:=Sheets(Sheets.Count)
  Sheets(sorsz + 1).Name = Sheets(1).Cells(sorsz + 1, 1).Value
  
  Sheets("Munka1").Select
  Range("A1:I1").Select
  Selection.Copy
  Sheets(1 + sorsz).Select
  Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
  False, Transpose:=True
  Sheets("Munka1").Select
  Range("A" & sorsz + 1, "I" & sorsz + 1).Select
  activerow = Range("A" & sorsz + 1, "I" & sorsz + 1).Value
  Selection.Copy
  Sheets(1 + sorsz).Select
  Cells(1, 2).Select
  Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
  False, Transpose:=True
  Columns("A:B").EntireColumn.AutoFit
  
  Next sorsz
  
  Sheets("Munka1").Delete
  ActiveWorkbook.SaveAs "C:\Documents and Settings\agb\Dokumentumok\masneven.xlsm"
  
  
  End Sub

  Abból a munkafüzetből indul ahol a kiindulási lista van, elkészíti a munkalapokat igény szerint, majd törli az eredeti lista munkalapját és menti a munkafüzetet más néven.
  Nem egy minden részletében kimunkált végleges megoldás inkább csak gondolatébresztő, de működik.

  Érdekelnének a szakértő vélemények.

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