Este fórum está sendo desativado

[braz]

Boa tarde,

Gostaria de contar com a ajuda de vocês.
Estou com uma planilha (anexo) que apresenta algumas inconsistências...

a) Se eu começar a preencher de A a Z a ordenação ocorre certinha, se eu começar o cadastramento de Z a A ela faz a ordenação certinha, porém, desloca o numero de ordem/item que esta na coluna A.

b) Esta planilha (coluna C) não tenho como prever um numero fixo de linhas, porém, a cada 20 nomes cadastrado tenho que fechar o formulário e inserir as linhas pra total e aprovação. Como faço quando chego nas linhas 21,51,61,81...

Atenciosamente

[osvaldomp]

Experimente uma cópia do código abaixo no lugar do existente.

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim rng As Range
  If Target.Column <> 3 Then Exit Sub
  Set rng = Target.CurrentRegion.Cells(2, 3).Resize(Target.CurrentRegion.Rows.Count - 1, 1)
  rng.Sort key1:=rng.Cells(1, 1), Order1:=xlAscending
End Sub

[braz]

Agradeço a resposta, mas surgiu o seguinte problema conforme o print em anexo:
O segundo bloco a começar pelo C29 não esta redirecionando para o primeiro bloco de forma a manter a ordem alfabética sequencial para todos os blocos.

[osvaldomp]

O segundo bloco a começar pelo C29 não esta redirecionando para o primeiro bloco de forma a manter a ordem alfabética sequencial para todos os blocos.

Sim, erradamente antes eu entendi que a classificação seria independente em cada bloco.
Instale uma cópia do código abaixo no lugar do anterior.

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim k As Long, m As Long
  If Target.Column <> 3 Then Exit Sub
  Application.ScreenUpdating = False
  If Not Intersect(Target, [C7:C26]) Is Nothing And [C29] = "" Then
   [C7:C26].Sort key1:=[C6], Order1:=xlAscending
  Else
   For k = 7 To Cells(Rows.Count, 1).End(3).Row - 20 Step 22
    If Cells(k, 3) <> "" Then
     Cells(k, 3).Resize(20).Copy
     Cells(Rows.Count, 23).End(3)(2).PasteSpecial xlValues
    Else: Exit For
    End If
   Next k
   Range("W1:W" & Cells(Rows.Count, 23).End(3)(2).Row).Sort key1:=[W1], Order1:=xlAscending
   On Error GoTo fm
   Application.EnableEvents = False
    For k = 1 To Cells(Rows.Count, 23).End(3).Row Step 20
     If Cells(k, 23) <> "" Then
      Cells(k, 23).Resize(20).Copy
      Cells(m + 7, 3).PasteSpecial xlValues: m = m + 22
     Else: Exit For
     End If
    Next k
    Columns(23) = ""
   End If
fm:
   Application.EnableEvents = True
   Application.ScreenUpdating = True
End Sub

obs. na planilha EFETIVO há enorme quantidade de figuras ocultas, aparentemente são Caixas de Texto e sem utilidade. É conveniente apagá-las pois elas retardam a execução do código, poderão provocar erros e sobrecarregam o arquivo.
Para selecionar todas e apagá-las tecle F5 / Especial / Objetos / OK / aperte Delete

[braz]

Osvaldo,
Muito obrigado pelas respostas.
Porém surgiu mais uma duvida, essa planilha eu formatei com cinco blocos e o código que você me enviou esta englobando 4 blocos. Me oriente como inserir o 5º e posteriormente mais algum se necessário.

[osvaldomp]

Podes acrescentar quantos blocos quiseres.

A única restrição é que, a partir do segundo bloco, ao inserir o primeiro nome em um bloco qualquer, sempre o faça na primeira linha do bloco, pois o código irá verificar se há nome na primeira linha de cada bloco e irá interromper a busca no bloco cuja primeira linha esteja vazia.

[braz]

Osvaldo, Muito Obrigado