Página 1 de 1
Macro arrastar fórmula
Enviado: 11 Jun 2018 às 13:01
por matheusdoexcel
Boa tarde pessoal!
Estou tentando criar uma macro, mas estou encontrando muitas dificuldades.
Preciso de uma macro que identifique que a célula A3 é <> "" e com isso, arraste as fórmulas de B2 e C2 para B3 e C3. Mas gostaria que isso fosse feito em loop, então seria a macro identificar qual a última célula de A preenchida e arrastar a fórmula para ela.
Alguém sabe como fazer?
Mt obrigado, abraços
Re: Macro arrastar fórmula
Enviado: 11 Jun 2018 às 18:20
por osvaldomp
Experimente:
Código: Selecionar todosSub ReplicaFórmulas()
Dim c As Range
For Each c In Range("A3:A" & Cells(Rows.Count, 1).End(3).Row)
If c.Value <> "" Then [B2:C2].Copy c.Offset(, 1)
Next c
End Sub
Macro arrastar fórmula
Enviado: 12 Jun 2018 às 10:18
por matheusdoexcel
Osvaldo, muito obrigado pela contribuição, realmente atende o que eu havia colocado, mas me deparei com um problema que eu não havia falado. A planilha conta com cerca de 3000 linhas, todas preenchidas. Essa macro eu rodaria quando fossem incluídas novas linhas somente, o ideal seria que a fórmula identificasse somente essas últimas linhas preenchidas e arrastasse a fórmula somente para elas, para não tem que rodar em todas as 3000 linhas toda vez que fosse atualizar. Tem noção se isso é possível?
Abs
Re: Macro arrastar fórmula
Enviado: 12 Jun 2018 às 14:59
por osvaldomp
Este código irá pintar de amarelo a última célula processada e na vez seguinte irá processar somente as células abaixo da célula antes pintada.
Código: Selecionar todosSub ReplicaFórmulas()
Dim c As Range, LR As Long, am As Range, x As Long
LR = Cells(Rows.Count, 1).End(3).Row
With Application.FindFormat.Interior
.Color = vbYellow
End With
Set am = [A:A].Cells.Find(What:="", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, SearchFormat:=True)
If Not am Is Nothing Then
If am.Row = LR Then Exit Sub
x = am.Row + 1
Else: x = 3
End If
For Each c In Range(Cells(x, 1), Cells(LR, 1))
If c.Value <> "" Then [B2:C2].Copy c.Offset(, 1)
If c.Row = LR Then c.Interior.Color = vbYellow
Next c
End Sub