Excel extrair para outra aba com criterio

[janiosba]

Prezados,

Volto a pedir ajuda porque estou me debatendo e não consigo concluir um trabalho.

Por inteira presunção achei que sabia e não sei nada mesmo.

O Osvaldo escreveu um código em outro tópico e não consegui encaixar dentro do código que peguei na net. Desta vez

espero fazer de uma forma melhor, inclusive vou anexar a planilha.

0 código em VBA precisa localizar na aba "transpor" os nomes dos clientes, coluna " i " . Após a localização deverá

copiar as celulas da mesma linha das colunas "A - B-D-F-G-H e I" para a aba "extrair".  IMPORTANTE Obsv. Ao

localizar o nome do cliente, coluna "i"(aba "transpor") e copiar os dados pra aba "extrair" o próximo procedimento

e verificar na próxima linha da coluna "A"(aba "transpor") se a númeração repete, caso positivo, copiar as celulas

da mesma linha das colunas "A - B-D-F-G-H e I" para a aba "extrair". 

 

Abaixo código que estou usando. Ele não copia a venda cujo numeração se repete

 

Sub EXTRAIR_TRANSPOR()

Dim x As Integer
Dim j As Integer

j = 4

Sheets("EXTRAIR").Range("A3:Z20000").ClearContents

With Sheets("transpor")
    For x = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      If .Range("I" & x) <> "" Then
           Sheets("EXTRAIR").Range("A" & j) = .Range("A" & x)
          Sheets("EXTRAIR").Range("B" & j) = .Range("B" & x)
          Sheets("EXTRAIR").Range("c" & j) = .Range("D" & x)
          Sheets("EXTRAIR").Range("d" & j) = .Range("F" & x)
          Sheets("EXTRAIR").Range("e" & j) = .Range("G" & x)
          Sheets("EXTRAIR").Range("F" & j) = .Range("H" & x)
          Sheets("EXTRAIR").Range("G" & j) = .Range("I" & x)
           j = j + 1
          End If
        Next x
 End With
    MsgBox " PROCESSO CONCLUÍDO"

End Sub

 

Atenciosamente 

Janio 

 

 

 

EXTRAIR .rar

[Patropi]

@janiosba

 

Normalmente as pessoas digitam na planilha postada o resultado esperado, assim fica mais fácil de entendermos.

 

[]s

[janiosba]

1 hora atrás, Patropi disse:

@janiosba

 

Normalmente as pessoas digitam na planilha postada o resultado esperado, assim fica mais fácil de entendermos.

 

[]s

Vou 

adicionado 0 minutos depois

Vou refazer e anexar novamente .

 

Grato

 

Janio

[janiosba]

5 horas atrás, Patropi disse:

@janiosba

 

Normalmente as pessoas digitam na planilha postada o resultado esperado, assim fica mais fácil de entendermos.

 

[]s

Patropi,

 

Arquivo refeito e anexado.

 

Att

Janiosba

[Visitante]

No resultado desejado você colocou 4 registros que não atendem ao seu primeiro critério, pois as células correspondentes na coluna I estão vazias, ou seja, não há clientes para aqueles registros.

Verifique esses casos na planilha TRANSPOR, registros em A14:A15 e em A29:A30.

O código abaixo não levará tais registros para o resultado. Retorne para ajustes no código se você alterou o critério.

Sub ExtraiDados()
 Dim LR As Long
  Application.ScreenUpdating = False
  With Sheets("TRANSPOR")
   .AutoFilterMode = False
   .[J:J] = ""
   LR = .Cells(Rows.Count, 1).End(3)(2).Row
   .Range("J2:J" & LR).Formula = "=OR(I2<>"""",COUNTIF(A$2:A$51,A2)>1)"
   .Range("A1:J1").AutoFilter Field:=10, Criteria1:="VERDADEIRO"
   Sheets("EXTRAIR").[A:G] = ""
   .Range("A1:I" & LR).Copy Sheets("EXTRAIR").[A1]
   .AutoFilterMode = False
   .[J:J] = ""
  End With
  Sheets("EXTRAIR").Range("C:C,F:F").Delete
  Application.ScreenUpdating = True
End Sub

 

[janiosba]

12 horas atrás, osvaldomp disse:

No resultado desejado você colocou 4 registros que não atendem ao seu primeiro critério, pois as células correspondentes na coluna I estão vazias, ou seja, não há clientes para aqueles registros.

Verifique esses casos na planilha TRANSPOR, registros em A14:A15 e em A29:A30.

O código abaixo não levará tais registros para o resultado. Retorne para ajustes no código se você alterou o critério.

Sub ExtraiDados()
 Dim LR As Long
  Application.ScreenUpdating = False
  With Sheets("TRANSPOR")
   .AutoFilterMode = False
   .[J:J] = ""
   LR = .Cells(Rows.Count, 1).End(3)(2).Row
   .Range("J2:J" & LR).Formula = "=OR(I2<>"""",COUNTIF(A$2:A$51,A2)>1)"
   .Range("A1:J1").AutoFilter Field:=10, Criteria1:="VERDADEIRO"
   Sheets("EXTRAIR").[A:G] = ""
   .Range("A1:I" & LR).Copy Sheets("EXTRAIR").[A1]
   .AutoFilterMode = False
   .[J:J] = ""
  End With
  Sheets("EXTRAIR").Range("C:C,F:F").Delete
  Application.ScreenUpdating = True
End Sub

 

Osvaldo,

Perfeito. Estava concentrando somente na utilização do código. Seu raciocínio de usar fórmula me ajudou. Adaptei a fórmula é resultado superou.

Grato. Muito bom mesmo.

 

Janio