none
Copiar e colar em outra aba RRS feed

  • Pergunta

  • Boa tarde, alguém poderia me ajudar?

    Tenho uma data na célula M9 da aba relatório geral
    E como na imagem abaixo, tenho várias datas na aba banco de dados para colar os valores nela
    Mas para cada data são 3 turnos. Queria colar o valor da célula C11 e C12 nessa aba banco de dados, se as datas forem iguais, nas duas abas.
    No codigo abaixo oC12 estava mesclado então separei e voltei ele ao normal

    Fiz um loop mas parece não estar funcionando.

    Depois vou adaptar esse código para os outros 2 turnos que estão do lado.

    Estou usando o seguinte código:

    n = Worksheets("Relatório Geral").Range("M9").Value
    dia = n
    I = 0
    tempo_compara = Now()

    If Err.Number <> 0 Then
    GoTo bypass_1
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''cola nome e turno
    If C10 <> 0 Then
    If tempo_compara >= Worksheets("Relatório Geral").Range("M9").Value Then
    Worksheets("Relatório Geral").Select
        Range("C12:E12").Select
        With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = True
        End With
        Selection.UnMerge
        Range("C11:C12").Select
        Application.CutCopyMode = False
        Selection.Copy
    Worksheets("Banco de Dados").Select
    k = 0
    On Error Resume Next
    Do While n >= Cells(1, 3 + 3 * k).Value
    'If Err.Number <> 0 Then
    'GoTo bypass_0
    'End If
        If n = Cells(1, 3 + 3 * k).Value Then
         Worksheets("Banco de Dados").Select
            Cells(122, 3 + 3 * k).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        End If
      If n = Cells(1, 3 + 3 * k).Value Then
        Exit Do
        Sheets("Relatório Geral").Select
        Range("C12:E12").Select
        Application.CutCopyMode = False
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Selection.Merge
      End If
    k = k + 1
    Loop
    End If
    End If

    'bypass_0:
    'Resume Next
    bypass_1:
    Application.ScreenUpdating = True

    Imagem:

     |     dataaaaaaaaaaaaaaaaa      |

    |turno 1 |   turno 2  |   turno 3  |


    sexta-feira, 11 de dezembro de 2020 18:58