• Olá Visitante, se gosta do forum e pretende contribuir com um donativo para auxiliar nos encargos financeiros inerentes ao alojamento desta plataforma, pode encontrar mais informações sobre os várias formas disponíveis para o fazer no seguinte tópico: leia mais... O seu contributo é importante! Obrigado.

Ajuda - inserir linhas e copiar/colar no VBA

scbraga1921

GF Bronze
Membro Inactivo
Entrou
Nov 22, 2006
Mensagens
11
Gostos Recebidos
0
Olá, estou a precisar de ajuda no VBA, pois ainda estou a começar a aprender a trabalhar naquilo. Entretanto fiz um código para adicionar linhas e copiar/colar uma linhas qe contém formulas. No entanto, ao testar, se pedir 7 linhas ele dá é umas 100. Não percebo o erro, alguém me pode ajudar?
A coluna é fixa, não preciso de adicionar...

O código é este:

Sub line()
Const coluna1 As Long = 1
Const coluna2 As Long = 6
Dim i As Long
Dim auxiliar As Long
linha = InputBox("A partir de qual linha?")
k = InputBox("Quantas linhas?")
auxiliar = linha
For i = linha To linha + k
With Application
.Range(.Cells(linha, coluna1), .Cells(linha, coluna2)).Select
End With
Selection.Insert Shift:=xlDown
linha = linha + 1
Next i
With Application
.Range(.Cells(linha, coluna1), .Cells(linha, coluna2)).Copy 'É a partir desta que eu qero copiar, sempre.
.Range(.Cells(auxiliar, coluna1), .Cells(linha, coluna2)).PasteSpecial xlPasteAll
End With
Application.CutCopyMode = False
'Desactiva o método de cópia
End Sub
 
Última edição:

scbraga1921

GF Bronze
Membro Inactivo
Entrou
Nov 22, 2006
Mensagens
11
Gostos Recebidos
0
Parece que já consegui, aqui fica o programa para a qem for útil poder usar :)

Sub line()
Const coluna1 As Long = 1
Const coluna2 As Long = 5
Dim i As Long
Dim auxiliar As Long

linha = InputBox("A partir de qual linha?")
k = InputBox("Quantas linhas?")
auxiliar = linha
For i = 1 To k Step 1
With Application
.Range(.Cells(linha, coluna1), .Cells(linha, coluna2)).Select
End With
Selection.Insert Shift:=xlDown
linha = linha + 1
Next i
With Application
.Range(.Cells(linha, coluna1), .Cells(linha, coluna2)).Copy
.Range(.Cells(auxiliar, coluna1), .Cells(linha, coluna2)).Select
Selection.PasteSpecial xlPasteAll
End With
Application.CutCopyMode = False
'Desactiva o método de cópia
End Sub


Aceitam-se na mesma comentários
 
Topo