Eloize Teixeira

Boa tarde, pessoal ! Estou com um problema. Eu tenho uma conexão de dados de uma lista do Sharepoint pro Excel, onde a mesma é dinâmica, ou seja, novas linhas podem aparecer e/ou sumir. Essa Conexão chama-se "NPI" (vide anexo), e o intervalo vai da coluna A até AR, no entanto, utilizo as colunas paralelas para realizar anotações referente a cada linha.. AGORA o PROBLEMA: Quando uma linha some (porque já foi solucionada), o método QueryTable exclui a linha até a coluna AR (intervalo máximo da conexão), e as colunas paralelas ao invés de excluir junto (porque as anotações pertinentes não valem mais, se deslocam apenas, fazendo com que fique anotações da linha já excluída para uma nova existente. PERGUNTA: Como faço para que no comando VBA, atualize a conexão/intervalo da tabela de conexão exclua a linha inteira, e não só até o intervalo máximo de conexão ? Desde já, muito obrigada !

minha macro abaixo não faz uma das tarefas, que é ver os valores da aba Data - coluna AV, se existe na aba Week Update - coluna AK, e caso só exista da aba Data, então o respectivo valor na Coluna AT, mudar para "Historical" planilha aqui Sub DataUpdate() Dim Dary As Variant, Hary As Variant, Uary As Variant, Nary As Variant, Nhary As Variant Dim i As Long, c As Long, UsdRws As Long, nr As Long Dim Dic As Object Application.ScreenUpdating = False Worksheets("Data").Unprotect Password:="Henkel2020" Set Dic = CreateObject("scripting.dictionary") With Sheets("Week Update") UsdRws = .Range("C" & Rows.Count).End(xlUp).Row Uary = .Range("A3:AK" & UsdRws) End With With Sheets("Data") UsdRws = .Range("C" & Rows.Count).End(xlUp).Row Dary = .Range("AV3:AV" & UsdRws).Value2 Hary = .Range("AT3:AT" & UsdRws).Value2 End With For i = 1 To UBound(Dary) Dic(Dary(i, 1)) = i Next i With Sheets("Data") Dary = .Range("A3:AJ" & UsdRws).Value2 End With ReDim Nary(1 To UBound(Uary), 1 To 36) For i = 1 To UBound(Uary) If Dic.Exists(Uary(i, 37)) Then For c = 1 To 36 Dary(Dic(Uary(i, 37)), c) = Uary(i, c) Next c If Hary(Dic(Uary(i, 37)), 1) = "Historical" Then Hary(Dic(Uary(i, 37)), 1) = "" Else nr = nr + 1 For c = 1 To 36 Nary(nr, c) = Uary(i, c) Next c Hary(i, 1) = "Historical" ' what there are in "Data" but do not exists on "Week Update", the value is not changed to "Historical" End If Next i With Sheets("Data") .Range("A3:AJ" & UsdRws).Value = Dary .Range("AT3:AT" & UsdRws).Value = Hary If nr > 0 Then .Range("A" & UsdRws + 1).Resize(nr, 36).Value = Nary End If End With Sheets("Week Update").ListObjects(1).DataBodyRange.EntireRow.Delete Sheets("Week Update").Range("Update[Document NumberDocument Line Number]") = "=[@[Document Number]]&[@[Document Line Number]]" Worksheets("Data").Protect Password:="Henkel2020", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, UserInterfaceOnly:=True Worksheets("Data").EnableOutlining = True Application.ScreenUpdating = True End Sub

Boa noite, alguém sabe como consigo deixar mais intuitivo e rápido a macro abaixo ? linha = 3 Do While Sheets("Data").Cells(linha, "C") <> Empty Var3 = Application.Match(Sheets("Data").Cells(linha, "AV").Value, Sheets("Week Update").Columns(37), 0) If WorksheetFunction.IsError(Var3) Then 'caso 3: existe uma linha na planilha primária (Data) que foi deletada da semana atual(Week Update) linha_apagada = linha Sheets("Data").Cells(linha, "AT") = "Historical" End If linha = linha + 1 Loop o resto do código está como abaixo, mas parte dele não funciona como preciso (onde está com o comentário), e não estou conseguindo consertar, mas seria basicamente o código acima, só que chique como abaixo, e inserido no esquema abaixo: basicamente a parte que falta, é : se tem na aba data, checando a coluna AV com a aba Week Update com a coluna AK, e não existe na Week Update, então a linha checada na aba Data coluna AT fica como "Historical" Sub DataUpdate() Dim Dary As Variant, Hary As Variant, Uary As Variant, Nary As Variant, Nhary As Variant Dim i As Long, c As Long, UsdRws As Long, nr As Long Dim Dic As Object Application.ScreenUpdating = False Worksheets("Data").Unprotect Password:="Henkel2020" Set Dic = CreateObject("scripting.dictionary") With Sheets("Week Update") UsdRws = .Range("C" & Rows.Count).End(xlUp).Row Uary = .Range("A3:AK" & UsdRws) End With With Sheets("Data") UsdRws = .Range("C" & Rows.Count).End(xlUp).Row Dary = .Range("AV3:AV" & UsdRws).Value2 Hary = .Range("AT3:AT" & UsdRws).Value2 End With For i = 1 To UBound(Dary) Dic(Dary(i, 1)) = i Next i With Sheets("Data") Dary = .Range("A3:AJ" & UsdRws).Value2 End With ReDim Nary(1 To UBound(Uary), 1 To 36) For i = 1 To UBound(Uary) If Dic.Exists(Uary(i, 37)) Then For c = 1 To 36 Dary(Dic(Uary(i, 37)), c) = Uary(i, c) Next c If Hary(Dic(Uary(i, 37)), 1) = "Historical" Then Hary(Dic(Uary(i, 37)), 1) = "" Else nr = nr + 1 For c = 1 To 36 Nary(nr, c) = Uary(i, c) Next c Hary(i, 1) = "Historical" 'eu acho que essa parte não ta funcionando, que seria, se não achar o valor da coluna [Data] AV em [Week Update] AK, então [Data] AT, fica com o valor "Historical" End If Next i With Sheets("Data") .Range("A3:AJ" & UsdRws).Value = Dary .Range("AT3:AT" & UsdRws).Value = Hary If nr > 0 Then .Range("A" & UsdRws + 1).Resize(nr, 36).Value = Nary .Range("AT" & UsdRws + 1).Resize(nr, 1).Value = Nhary End If End With Sheets("Week Update").ListObjects(1).DataBodyRange.EntireRow.Delete Sheets("Week Update").Range("Update[Document NumberDocument Line Number]") = "=[@[Document Number]]&[@[Document Line Number]]" Worksheets("Data").Protect Password:="Henkel2020", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, UserInterfaceOnly:=True Worksheets("Data").EnableOutlining = True Application.ScreenUpdating = True End Sub após rodar a macro, se tiver certo os seguintes valores da coluna AV, ficarão como "Historical", na coluna AT; 40811073610 40820554010 40823667510 arquivo aqui

Olá especialistas, Eu tenho uma planilha chamada "Dados" e, lá da linha 4 e ao longo, tenho vários pontos com dados, como "Responsável principal" em AO, "País" em AK e "SBU" em AL; Também tenho outra planilha chamada "AuthUsers", onde criei a matriz abaixo; então, estou procurando um código VBA, que toda vez que uma pessoa abre o arquivo, filtra automaticamente essas colunas de acordo com a matriz abaixo; 1 - Na coluna "País", filtre duas opções se a matriz tiver vírgula; 2 - se estiver em branco, sem filtro; 3- se o nome não estiver nas colunas "Usuário", não é necessário filtro; Eu geralmente uso Application.UserName para ter esse recurso, mas não sei se outra maneira poderia ser melhor; você poderia me ajudar nisso?

Olá Mundo. Eu escrevi um código VBA para encontrar um valor em uma planilha e, se corresponder, basta copiar a linha inteira. OK, não é só isso, deixe-me explicar como funciona e o problema que estou enfrentando: Primeira folha, chamada "DATA"; Segunda folha, chamada "UPDATE DA SEMANA" 1 - A pessoa cola os dados pré-selecionados na planilha "WEEK UPDATE" e depois pressiona o botão para verificar se o valor existente na planilha existe na planilha "DATA"; SE SIM, a linha de A a AJ ("atualização semanal") é substituída na planilha "dados" nos mesmos colunares Caso contrário, a linha de A a AJ ("atualização semanal") é COLOCADA na planilha "dados" nos mesmos colunares 2 - O sistema verifica se os dados da planilha "data" não existem na planilha "atualização semanal", portanto, coloque um valor no colo AN como "Histórico" Se o collunm já estiver como "Histórico" e o sistema encontrar o valor de "Dados" em "atualização semanal", o valor "histórico" será sobrescrito como ""; .. AGORA MEU PROBLEMA ... Funciona muito bem, mas com uma pequena quantidade de linhas .. Estou usando linhas de 50K em "atualização semanal" e ~ 40K em "dados" e a macro não funciona alguma ajuda, POR FAVOR? ANEXO AQUI https://drive.google.com/file/d/1hwIvOUmTBBJdR5Ps1peWWOdVqvVosr1s/view?usp=sharing siga o código: Sub Preencher_dados() Application.ScreenUpdating = False Worksheets("Data").Unprotect Password:="Henkel2020" Worksheets("Week Update").Unprotect Password:="Henkel2020" Sheets("Data").Columns("AP").EntireColumn.Hidden = False Sheets("Week Update").Columns("AK").EntireColumn.Hidden = False linha = 3 contagem = 0 ultima_linha1 = Sheets("Data").Range("C80000").End(xlUp).Row ultima_linha2 = Sheets("Week Update").Range("C80000").End(xlUp).Row If ultima_linha2 <= 2 Then MsgBox "Não existem novos dados a serem transferidos.", vbExclamation: GoTo Final 'i = 3 'concatena coluna H e I da planilha Data 'Do While i <= ultima_linha1 ' Sheets("Data").Cells(i, "AP") = CStr(Sheets("Data").Cells(i, "H") & Sheets("Data").Cells(i, "I")) ' i = i + 1 'Loop 'i = 3 'concatena coluna H e I da planilha Week Update 'Do While i <= ultima_linha2 ' Sheets("Week Update").Cells(i, "AK") = CStr(Sheets("Week Update").Cells(i, "H") & Sheets("Week Update").Cells(i, "I")) ' i = i + 1 'Loop 'verificar adição de novas linhas (Secundária busca na primária) linha = 3 texto = "Existem materiais que necessitam de revisão na(s) linha(s): " Do While Sheets("Data").Cells(linha, "C") <> Empty Var3 = Application.Match(Sheets("Data").Cells(linha, "AP").Value, Sheets("Week Update").Columns(37), 0) If WorksheetFunction.IsError(Var3) Then 'caso 3: existe uma linha na planilha primária que foi deletada da semana atual linha_apagada = linha Sheets("Data").Cells(linha, "AN") = "Historic" End If If Not WorksheetFunction.IsError(Var3) And Sheets("Data").Cells(linha, "AN") = "Historic" Then 'caso 3: existe uma linha antes deletada que voltou semana atual contagem = 1 texto = texto & vbCr & linha & ";" Sheets("Data").Cells(linha, "AN") = Empty End If linha = linha + 1 Loop Do While Sheets("Week Update").Cells(linha, "C") <> Empty Var1 = Application.Match(Sheets("Week Update").Cells(linha, "AK").Value, Sheets("Data").Columns(42), 0) If WorksheetFunction.IsError(Var1) Then 'caso 1: existe uma nova linha na semana atual Sheets("Week Update").Cells(linha, 1).Resize(1, 36).Copy Destination:=Sheets("Data").Range("A80000").End(xlUp).Offset(1, 0) End If If Not WorksheetFunction.IsError(Var1) Then 'caso 2: não existe uma nova linha na semana atual -> subscrever linha_sub = Sheets("Data").Columns(42).Find(Sheets("Week Update").Cells(linha, "AK"), LookIn:=xlValues).Row Sheets("Week Update").Cells(linha, 1).Resize(1, 36).Copy Destination:=Sheets("Data").Cells(linha_sub, 1) End If linha = linha + 1 Loop 'verificar exclusão de linhas (primária busca na secundária) 'i = 3 'concatena coluna H e I da planilha Data 'ultima_linha1 = Sheets("Data").Range("A1048576").End(xlUp).Row 'Do While i <= ultima_linha1 ' Sheets("Data").Cells(i, "AP") = CStr(Sheets("Data").Cells(i, "H") & Sheets("Data").Cells(i, "I")) ' i = i + 1 'Loop Application.ScreenUpdating = True If contagem = 1 Then MsgBox texto, vbExclamation Final: Sheets("Week Update").Rows("4:80000").Delete Shift:=xlUp Sheets("Week Update").Range("A3:AJ3").ClearContents Sheets("Data").Columns("AP").EntireColumn.Hidden = True Sheets("Week Update").Columns("AK").EntireColumn.Hidden = True Sheets("Data").Select Worksheets("Data").Protect Password:="Henkel2020", DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFiltering:=True Worksheets("Week Update").Protect Password:="Henkel2020" Application.ScreenUpdating = True End Sub

Boa tarde pessoal, Sou iniciantes e as vezes me deparo com algumas não funcionalidades que não sei consertar, como abaixo: Tenho dois OptionButton e uma combobox, a principio o intuito é liberar a combobox somente se determinada optionbutton for selecionada. Optionbutton11 = True -> Combobox5 fica liberada Optionbutton12 = True -> Combobox5 nao fica liberada Optionbutton11 & Optionbutton12 = False -> Combobox5 nao fica liberada Poderiam me ajudar? Private Sub ComboBox5_Change() If OptionButton11 = True And OptionButton12 = False Then ComboBox5.Locked = False ComboBox5.Enabled = False ElseIf OptionButton11 = False And OptionButton12 = True Then ComboBox5.Locked = True ComboBox5.Enabled = True ElseIf OptionButton11 = False And OptionButton12 = False Then ComboBox5.Locked = True ComboBox5.Enabled = True End If End Sub

@Basole No privado.

@Basole Ta demorando muito, e são aproximadamente 1500 linhas. Ainda está rodando, então não sei o resultado ao certo, posso lhe enviar a planilha?

Gente, boa tarde! Faz muito tempo que não mexo com VBA e estou meio que com pressa, gostaria de saber se vocês podem ajudar. Tenho uma planilha com duas abas. Plan 1 = Preencher os dados correspondentes Plan2 = Onde estão todos os dados Plan 1 A B C D E 1 2 3 Plan 2 A B C D E 1 abacaxi ww ww ww 2 mamao ww ww ww 3 xuxu ww ww ww 4 joelho 5 computador Ao apertar um botao da Plan 2, a Plan 1 se prencha com os dados correspondentes: Plan1 A B C D E 1 abacaxi ww ww ww 2 mamao ww ww ww 3 xuxu ww ww ww Poderiam me ajudar?

@Basole Como faz isso?

@Basole eu tinha feito isso antes mas não tinha funcionado.... mas deu certo.

Boa tarde, Surgiu a necessidade de adicionar mais do que um anexo em minha macro para envio automático de e-mails no Excel, no entanto, procurei na internet e vi alguns fóruns dizendo para separar com ";", mas mesmo assim está dando erro. Será que poderiam me ajudar?: Sub EmitirRelatorio() Dim nome As String, HTMLBody As String Dim OA As Object, OM As Object Dim lMax As Long Dim lLinhaAtual As Long nome = Environ("USERPROFILE") & "\AppData\Local\Temp\" & Range("c1").Value & ".pdf";"G:\BRITA-CD_Itapevi\KPI Logistica\Expedição Pallets - Controle\Template\Padrão Minimo de Qualidade - Pallets Devolução.pdf" With OM .To = Sheets("Emitir Relatório").Range("E53").Value .CC = Sheets("Emitir Relatório").Range("E54").Value .Subject = "Relatório Pallets - " & "Período Acumulado Até: " & Sheets("Relat. Template").Range("D9") .HTMLBody = HTMLBody & "<br>" .Attachments.Add nome .Send End With Erro: (em anexo) _____________ Não está dando certo dessa forma. Arquivo 1: Environ("USERPROFILE") & "\AppData\Local\Temp\" & Range("c1").Value & ".pdf" Arquivo 2: "G:\BRITA-CD_Itapevi\KPI Logistica\Expedição Pallets - Controle\Template\Padrão Minimo de Qualidade - Pallets Devolução.pdf" É isso, se puderem me ajudar, agradecerei. Att, Elo

@osvaldomp Da onde você veio Osvaldo? Rs Você chega com umas soluções de outro mundo. Deu certo. adicionado 2 minutos depois @DJunqueira Muito obrigada pela sua disposição em me ajudar. Visualizei e realmente pareceu correto, mas ela funcionaria para mais de 3000 linhas ?! De qualquer forma obrigada! Arrasou.

@DJunqueira Muito obrigada. Desde já agradeço à atenção.

@DJunqueira 2013 Me ajuda? Preciso muito muito.

@osvaldomp @Basole

Bom dia, Estou desenvolvendo uma macro para importar um grande número de dados para o SAP, porém ele precisa estar no layout correto. Pois bem, os dados iniciais foram digitados em linhas e preciso que parte deles fique em coluna. (vide Exemplo planilha em anexo). Escrevi um código levando em consideração exemplos de um colega, mas não consigo terminar a parte de não substituir alguns dados. (vide planilha).. Abaixo o código. Please, poderiam me ajudar? Urgente Sub Replicadados() Dim LRo As Long, LRd As Long, ND As Range Sheets("Teste").Range("A1") = "CABECA" Sheets("Teste").Range("A2") = "LINHA" Sheets("Teste").Range("B1") = "OBJECT" Sheets("Teste").Range("B2") = "TEXTTYPE" Sheets("Teste").Range("C1") = "IDH" Sheets("Teste").Range("C2") = "TEXT" Sheets("Teste").Range("D1") = "ORG" Sheets("Teste").Range("E1") = "CANAL" Sheets("Teste").Range("F1") = "SETOR" Sheets("Teste").Range("G1") = "TEXTID" Sheets("Teste").Range("H1") = "LANGUAGE" LRo = Cells(Rows.Count, 1).End(xlUp).Row: If LRo < 7 Then Exit Sub For Each ND In Range("A7:A" & LRo) With Sheets("Teste") LRd = .Cells(Rows.Count, 1).End(xlUp).Row .Cells(LRd + 1, 1) = "H" .Cells(LRd + 2, 1) = "I" .Cells(LRd + 1, 2) = Cells(ND.Row, "E") .Cells(LRd + 2, 2) = "*" .Cells(LRd + 1, 3) = Cells(ND.Row, "D") .Cells(LRd + 2, 3) = "Shelf Life (dias): " & Cells(ND.Row, "K") .Cells(LRd + 3, 3) = "Aceita Saldo?: " & Cells(ND.Row, "L") .Cells(LRd + 4, 3) = "Fornecimento completo?: " & Cells(ND.Row, "M") .Cells(LRd + 5, 3) = "Aceita NF do Mês ANTERIOR?: " & Cells(ND.Row, "N") .Cells(LRd + 6, 3) = "Qtd de dias que podemos antecipar a entrega: " & Cells(ND.Row, "O") .Cells(LRd + 7, 3) = "Necessita de agendamento?: " & Cells(ND.Row, "P") .Cells(LRd + 8, 3) = "Responsável agendamento: " & Cells(ND.Row, "Q") .Cells(LRd + 9, 3) = "Permitido agrupamento de pedidos x NF: " & Cells(ND.Row, "R") .Cells(LRd + 1, 4) = Cells(ND.Row, "A") .Cells(LRd + 1, 5) = Cells(ND.Row, "B") .Cells(LRd + 1, 6) = Cells(ND.Row, "C") .Cells(LRd + 1, 7) = "ZC01" .Cells(LRd + 1, 8) = "P" End With Next ND End Sub Como sai: CABECA OBJECT IDH ORG CANAL SETOR TEXTID LANGUAGE LINHA TEXTTYPE TEXT H Fulano 1140795 442 T3 38 ZC01 P I * Shelf Life (dias): 45 H Ciclano 2196178 442 T3 38 ZC01 P I * Shelf Life (dias): 30 H Extrafano 378141 442 T3 38 ZC01 P I * Shelf Life (dias): 30 Aceita Saldo?: SIM Fornecimento completo?: NÃO Aceita NF do Mês ANTERIOR?: SIM Qtd de dias que podemos antecipar a entrega: Não podemos antecipar (seguir Leatime) Necessita de agendamento?: NÃO Responsável agendamento: Sem agendamento Permitido agrupamento de pedidos x NF: NÃO Como gostaria que saísse: CABECA OBJECT IDH ORG CANAL SETOR TEXTID LANGUAGE LINHA TEXTTYPE TEXT H Fulano 1140795 442 T3 38 ZC01 P I * Shelf Life (dias): 45 I * Aceita Saldo?: SIM I * Fornecimento completo?: NÃO I * Aceita NF do Mês ANTERIOR?: SIM I * Qtd de dias que podemos antecipar a entrega: Não podemos antecipar (seguir Leatime) I * Necessita de agendamento?: NÃO I * Responsável agendamento: Sem agendamento I * Permitido agrupamento de pedidos x NF: SIM H Ciclano 2196178 442 T3 38 ZC01 P I * Shelf Life (dias): 30 I * Aceita Saldo?: SIM I * Fornecimento completo?: NÃO I * Aceita NF do Mês ANTERIOR?: SIM I * Qtd de dias que podemos antecipar a entrega: Não podemos antecipar (seguir Leatime) I * Necessita de agendamento?: NÃO I * Responsável agendamento: Sem agendamento I * Permitido agrupamento de pedidos x NF: SIM H Extrafano 378141 442 T3 38 ZC01 P I * Shelf Life (dias): 30 I * Aceita Saldo?: SIM I * Fornecimento completo?: NÃO I * Aceita NF do Mês ANTERIOR?: SIM I * Qtd de dias que podemos antecipar a entrega: Não podemos antecipar (seguir Leatime) I * Necessita de agendamento?: NÃO I * Responsável agendamento: Sem agendamento I * Permitido agrupamento de pedidos x NF: NÃO Planilha Particularidades mod.ddd .zip

@osvaldomp Você sempre arrasa, dá até vergonha assim! kkk adicionado 1 minuto depois Acho que dá pra usar um esquema parecido para resolver aquele meu outro problema, né? Para cada linha em uma aba, ele solta umas informações fixas preenchidas de acordo com a linha. Estou certa disso?

Boa tarde Pessoal, tudo bem? Estou aqui, quebrando minha cabeça, pois não consigo fazer rotina de Loop para Procurar uma informação em uma aba e adicionar em outra. Gostaria que vocês pudessem me ajudar, a propósito, preciso: A tabela "Data" jogo informações que sempre se atualizam; A tabela "Disputas" copiam informações da tabela Data, porém, atualizo a "Data" todos os dias, mas não posso perder informações do que já coloquei na tabela Disputas (EX.: Acompanhamento e ect). O que preciso é: Ao adicionar o conteúdo na aba "Data", o botão Atualizar iria procurar na aba "Disputas" (Ambas na coluna A) se a informação já estava lá, se estivesse ignoraria, mas se não tivesse copiar algumas da mesma linha e de colunas diferentes da aba "Data" para aba "Disputas". O codigo que tinha feito mas nãodeu certo Sub Localizar() Dim c As Range, LR As Long LR = Sheets("Disputas").Cells(Rows.Count, 1).End(xlUp).Row Do Set c = Sheets("Disputas").Range("A2:A" & LR).Find(Sheets("Data").Range("A:A").Value, LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then With Sheets("Disputas") c.Offset(0, 1).Value = Sheets("Data").Cells(x, "A") c.Offset(0, 2).Value = Sheets("Data").Cells(x, "B") c.Offset(0, 3).Value = Sheets("Data").Cells(x, "N") c.Offset(0, 4).Value = Sheets("Data").Cells(x, "D") c.Offset(0, 5).Value = Sheets("Data").Cells(x, "I") c.Offset(0, 6).Value = Sheets("Data").Cells(x, "J") End With End If Loop End Sub Disputas Oficial_V01.xls

Rsrsrsrs Ok, vamos lá! LINHATEXTTYPETEXT = É um cabeçario Fixo, na verdade na influencia em nada no processo de troca de layout dos dados; H = Head ou Cabeçario; Fulano = Nome no Cliente (É possível encontrar na Aba "Atual" - Coluna D); 1140795 = Código do Cliente (É possível encontrar na Aba "Atual" - Coluna C); 0442 = Um código relevante também possível d encontra na aba Atual na coluna A, e que pode mudar de acordo com o cliente (Nome e Codigo, conforme citado acima) Da coluna J a Q da Linha 1, é possível visualizar -> CS .. O que significa? É o setor responsável pelas informações das mesmas colunas só que da linha 2 (o que voce tambem tinha me perguntando da onde tiro a informação), que não deixa de ser uma informação fixa mas que deve ser repetida a cada novo cliente (nome, codigo e etc) Tanto é que, na Aba Esperado o Cliente "Fulano" se repete várias vezes, e dependendo de como ele se repete existe o * (que deve permanecer). Agora se voce observar na coluna G, tem a informação ZC01, ZC02 até ZC05 .. ai inicia outro cliente (outra linha da aba Atual) e começa novamente ZC01, ZC02 ... etc as informações de cabeçalho se repetem, o que muda sao as informações (Coluna D - Aba Esperado) de acordo com o cabeçalho (Coluna C - Aba Esperado). Ufa. Espero ter conseguido clarear.

Bom eu estava escrevendo uma resenha aqui para lhe explicar, mas vai na do @osvaldomp que você brilha, sempre com coisas novas, né?! rs Rsrsrs! (Vou copiar este código pra mim também.. kkk ) Abraços

Sub Botão1_Clique() Dim LR As Long LR = Sheets("Plan2").Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets("Plan2").Cells(LR, 1).Value = Sheets("Plan1").Range("C1").Value Sheets("Plan2").Cells(LR, 2).Value = Sheets("Plan1").Range("C2").Value Sheets("Plan2").Cells(LR, 3).Value = Sheets("Plan1").Range("B2").Value Sheets("Plan2").Cells(LR, 4).Value = Sheets("Plan1").Range("Q1").Value Sheets("Plan2").Cells(LR, 5).Value = Sheets("Plan1").Range("L1").Value End Sub

@osvaldomp Oi osvaldo, a origem dos dados vem das informações que constam nas atuais.. os dados são os mesmo, eles só precisam ser colocados da forma "Esperado" ... preciso de um botão sei lá, porque são muita linha e preciso fazer em massa.

Bom dia a todos, Estou com um probleminha, e embora saiba que seja possível resolver, não sei como começar a resolver, vide explicação em anexo da planilha (do que tenho e do que preciso): Basicamente tenho planilhas e as informações de um código estão em linha e parte deles preciso em linhas e parte em colunas, para posteriormente eu transformar em texto e fazer importaÇão em outra sistema. Preciso de um código para fazer isso automático, pois são mais de 2000 linhas Desde já, agradeço à atenção. Planilha Modelo_Clube HardWare.xlsx

@Basole Dá o mesmo problema que a minha macro. 0 - Subscrito fora do intervalo