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

• #20372 Delila_1 veterán misa479 #20371

  Új Válasz 2014-02-08 15:31:20 #20372

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

  A makróban a csillagokkal megjelölt sorban írd át a Munka1-et a saját lapod nevére, ami az adatokat tartalmazza.

  Sub KulonLapra()
  Dim felso As Long, also As Long, nev As String
  Dim WF As WorksheetFunction, WS As Worksheet
  
  Set WF = Application.WorksheetFunction
  Set WS = Sheets("Munka1") '**************
  WS.Activate
  
  'Rendezés a B oszlop szerint
  Range("A1").Select
  Selection.CurrentRegion.Select
  Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:= _
  xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
  DataOption1:=xlSortNormal
  
  felso = 2
  Do While Cells(felso, 1) <> ""
  nev = Range("B" & felso)
  also = WF.Match(nev, Columns("B"), 1)
  Sheets.Add.Name = nev
  WS.Activate
  Rows(1).Copy Sheets(nev).Range("A1")
  Rows(also & ":" & felso).Copy Sheets(nev).Range("A2")
  felso = also + 1
  Loop
  End Sub

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