Bom dia!!

Aqui tem o que você precisa.
http://www.rondebruin.nl/win/s3/win001.htm

Tente adaptar!

Att

caje,

Boa Tarde!

Não sei como é que você deseja pegar a coluna que tem a data do dia! Não consegui baixar seu arquivo compactado com o rar (creio que deve ser bloqueio aqui do trabalho). Todavia, se for por exemplo, a última coluna, você pode pegá-la com o código:

UltimaColuna = Sheets ("Plan1").Cells(1, Cells.Columns.Count).end(XlToLetf).Column

Se for uma coluna em cujo cabeçalho (linha 1-Exemplo) tem uma indicação do dia, você pode fazer um FOR para pegar a coluan certa, tipo isso:

For i = 1 to UltimaColuna
     If CDate(Cells(1, i).Value) = Date Then
     'Aqui entram os comandos que você quer
Next

Obrigado alexandre e Wagner vou tentar aplicar as 2 sugestões e ver se da certo .

No caso da sua resposta Wagner o que preciso é a segunda sugestão a do for vou tentar fazer.

Obrigado mais uma vez vou tentar fazer e assim que conseguir já post no fórum.

Wagner não sei se estou aplicando a estrutura do for errada mas ainda pega o intervalo errado

Estou tentando assim

Sub Importa()

Dim DernLigne As Long
Dim i As Integer
ActiveSheet.Unprotect
Application.ScreenUpdating = False
 
   
   
   Workbooks.Open Filename:= _
        ThisWorkbook.Path & "produto2.XLS"
    'COPIAR Dados Recebimento Produto2
Windows("produto2.xls").Activate

Ultimalinha = Range("H65536").End(xlUp).Row
Ultimacoluna = Cells(7, Cells.Columns.Count).End(xlToLeft).Column 'Preechi 7 pq é a linha do cabeçalho no arquivo de importação

For i = 1 To Ultimacoluna Step 1

     If (Cells(7, i).Value) = Range("A3") Then 'Essa celula A3 contém o valor 20 que é dia que tem no cabeçalho
     
     'Aqui entram os comandos que você quer
     Selection.Copy
     Windows("Placar_Recebimento.xlsb").Activate
     Sheets("plan1").Activate
     Range("B7").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
     End If
     
Next

Vou continuar tentando mais se tiver algum tempo e puder me ajudar com a estruta
Agredeceria muito

Segue a Macro em formato ZIP

Não consigo baixar arquivos zip aqui no trabalho.

Coloque um Break Point na linha onde está o IF e execute o código normalmente. Quando o VBA parar e destacar a linha onde está o Break Point na cor amarela, passe o mouse em cima dos comandos para ver quais são os valores que estâo sendo "pegos" nos comandos Cells(7, i).Value e Range("A3"), quando for a coluna correta. Veja, inclusive, se os valores são do mesmo tipo (String, por exemplo).

Wagner a primeira vez que executo Cells(7,i) no i ele passa 1 e no Range("A3") ele não exibe o valor mais cai dentro do IF. o que não deveria

Quando executo o for até o i ficar igual a 20 o Range("A3") exibe o valor 20 mas não cai dentro do if para realizar a copia.

Referente aos valores na Cells(7,i) eu declaro o i como inteiro pois acho que é um contador

na Range("A3") eu pego da tela principal da macro "A2" que é data e transformo em apenas 20 porém ele fica no formato geral na celula "A3" assim Range("A3") = Day(Range("A2")

transformando ele inteiro eu tento buscar ele no arquivo produto2 no cabeçalho da coluna 7 que está também no formato geral

Sou iniciante e com a sua dica já consegui perceber como identificar os valores e visualizar se é algum problema de logica

vou continuar tentando para ver se identifico algum problema na estrutura

Wagner fique a vontade para corrigir o raciocínio ou algum termo ou interpretação que estou fazendo errado no vba.

E Agradeço bastante as suas dicas.

caje,

Agora, em casa, consegui baixar seu arquivo. Vamos la:

a primeira vez que executo Cells(7,i) no i ele passa 1 e no Range("A3") ele não exibe o valor mais cai dentro do IF. o que não deveria

- Ele entra corretamente nessa primeira vez porque ambos os valores são vazio. Dessa forma, a comparação é verdadeira e o sistema entra corretamente no IF. Você está comparando, nesse momento, a célula A7 com a célula A3 do arquivo produto2.XLS, aba coaccao. O que você deseja fazer? Comparar com a célula A3 do arquivo Placar_Recebimento.xlsb, aba Plan1? Se for isso o código precisa explicitar todo o caminho a ser identificado tipo isso:

     If Workbooks("produto2.xls").Sheets("coaccao").Cells(7, i).Value = _
     Workbooks("Placar_Recebimento.xlsb").Sheets("Plan1").Range("A3").Value Then 'Essa celula A3 contém o valor 20 que é dia que tem no cabeçalho

A linha seguinte do seu código (após essa linha acima) é "Selection.Copy". Você está mandando copiar o que??? Não há nada selecionado! Antes do Selection.Copy você deve selecionar a célula que deve ser copiada para a célula B7 da Plab1 do arquivo Placar_Recebimento.xlsb, caso a condição do IF seja verdadeira.

É isso mesmo que preciso Wagner comparar A3 do arquivo Placar_Recebimento.xlsb, aba Plan 1 com a linha 7 do arquivo produto2.xls aba coacção onde contém o numero de cada dia do Mês quando ele localizar o valor igual a A3 deve então copiar a ultima celula dessa coluna definida pelo IF

Já estou tentando aplicar sua dica

Estou testando com breack que você ensinou ele ainda não puxa o valor de A3 da célula

Mas com sua dica ficou muito mais claro como resolver o problema .

Wagner consegui corrigir a condição do If adicionei uma variavél chamada dia e fiz ela receber o valor da celula "A3 " agora ele corre as colunas até a posição correta e cai dentro do if agora so preciso corrigir o script dentro do if para que rotina copie a ultima celula.

Sub Importa()

Dim DernLigne As Long
Dim i As Long
Dim dia As Integer  ' pegar a data do dia para busca
ActiveSheet.Unprotect
Application.ScreenUpdating = False
 
'---------------------------------------------------------------------------------------------------------
Windows("Placar_Recebimento.xlsb").Activate 'Atribuir o valor da celula do dia para fazer o if
dia = ActiveSheet.Range("A3")
 
 
 
   Workbooks.Open Filename:= _
        ThisWorkbook.Path & "produto2.XLS"
    
    'COPIAR Dados Recebimento Produto2
Windows("produto2.xls").Activate


Ultimalinha = Range("H65536").End(xlUp).Row
Ultimacoluna = Cells(7, Cells.Columns.Count).End(xlToLeft).Column 'Preechi 7 pq é a linha do cabeçalho no arquivo de importação



For i = 1 To Ultimacoluna Step 1

If Workbooks("produto2.xls").Sheets("coaccao").Cells(7, i).Value = dia Then 'Essa celula A3 contém o valor 20 que é dia que tem no cabeçalho
   
   Cells.Copy
   Selection.Copy
   Windows("Placar_Recebimento.xlsb").Activate
   Sheets("plan1").Activate
   Range("B7").Select

        
     End If
     
Next

Boa Tarde.

A solução do problema para importação foi realizada da seguite forma

Windows("Placar_Recebimento.xlsb").Activate 'Atribuir o valor da celula do dia para fazer o if
dia = ActiveSheet.Range("A3")
   
    Workbooks.Open Filename:= _
        ThisWorkbook.Path & "coaccao.XLS"
    
    'COPIAR Dados Recebimento Coacção
Windows("coaccao.xls").Activate

Ultimalinha = Range("H65536").End(xlUp).Row
Ultimacoluna = Cells(7, Cells.Columns.Count).End(xlToLeft).Column 'Preechi 7 pq é a linha do cabeçalho no arquivo de importação

For i = 1 To Ultimacoluna Step 1
  If Workbooks("coaccao.xls").Sheets("coaccao").Cells(7, i).Value = dia Then 'Essa celula A3 contém o valor do dia para for

            Cells(Ultimalinha, i).Select
            Selection.Copy
            Windows("Placar_Recebimento.xlsb").Activate
            Sheets("plan1").Activate
            Range("B7").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        
    End If
  Next

As Dicas do Wagner Morel foram muito uteis.