Este fórum está sendo desativado

[SergioSilva]

Preciso executar a macro abaixo até o final da planilha onde vou incrementando somente as células C5 e F5 em uma linha ...( primeira rodada com c5 e f5, segunda com c6 e f6 , terceira com c7 e f7..até o fim da planilha ou seja não haja mais registros na coluna C....

Sub Macro9()

Range("C5").Select
Application.CutCopyMode = False
Selection.Copy
Range("C2").Select
ActiveSheet.Paste
Range("F2:O2").Select
Application.CutCopyMode = False
Selection.Copy
Range("F5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

[eduardogrigull]

Olá, está meio difícil de entender, mas esse Script deve funcionar:

Código: Selecionar todos

Sub Copiar()
Dim UltimoRegistro As Integer
Application.ScreenUpdating = False

'Definir ultimo reg
If Cells.Range("C5").Value = Empty Then Exit Sub
UltimoRegistro = Cells.Range("C5").End(xlDown).Row

'Loop
For i = 5 To UltimoRegistro

    '   "transferir"
    Cells(i, 3).Copy
    Cells(i - 3, 3).PasteSpecial xlPasteAll
    
    Range("F" & i - 3 & ":O" & i - 3).Copy
    Cells(i, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Next

Application.CutCopyMode = False
Range("A1").Select
Application.ScreenUpdating = True
End Sub

[SergioSilva]

Boa Tarde eduardogrigull ... Não funcionou como esperado , tentei corrigir e não consegui, vou tentar ser mais claro...

A rotina é : copiar a celúla c5 e colar em c2 , ao fazer isto na Range f2:o2 ( que é fixa ) irá retornar valores de outra planilha que preciso copiar os valores e colar na célula F5. Vou fazer este processo de C5 até o último registro desta coluna C.

1 - copio C5 em C2, colo f2:o2 em f5
2 - copio c6 em c2, colo f2:o2 em f6
3- copio c7 em c2, colo f2:o2 em f7
4 - ..... idem até último registro

[osvaldomp]

Código: Selecionar todos

Sub Teste()
 Dim i As Long
  For i = 5 To Cells(Rows.Count, 3).End(3).Row
   [C2] = Cells(i, 3)
   Cells(i, 6).Resize(, 10) = [F2:O2].Value
  Next i
End Sub

[SergioSilva]

Muito agradecido meu amigo.... resolveu meu problema..... parabéns