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

• #22947 Delila_1 veterán rubint #22945

  Új Válasz 2014-08-18 07:12:11 #22947

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

  Úgy látom, 2003-asnál magasabb verziót használsz. Ha nem, akkor a Rendezes makrót át kell alakítanod.
  Az első makróban a Range("C3:K17") rész helyére írd a valós területet.

  Sub A_oszlopba()
  Dim ertek As Range
  
  For Each ertek In Range("C3:K17")
  If ertek > "" And Not IsNumeric(ertek) Then
  Range("A" & Application.WorksheetFunction.CountA(Columns(1)) + 1) = ertek
  End If
  Next
  
  Rendezes
  End Sub
  
  Sub Rendezes()
  Dim usor As Long
  
  usor = Range("A" & Rows.Count).End(xlUp).Row
  ActiveWorkbook.Worksheets("Munka1").Sort.SortFields.Add Key:=Range("A2:A" & usor) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveWorkbook.Worksheets("Munka1").Sort
  .SetRange Range("A1:A" & usor)
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
  End Sub

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