Copiar Linha selecionada para outro Livro

[Angra2011 0]

O código abaixo permite-me copiar os valores da linha selecionada de uma folha ("Registos"), para outra folha ("Resultados"), dentro do mesmo livro (Livro1).

Isto é, de cada vez que seleciono uma linha esta é copiada para a folha, mas sempre na linha seguinte dessa folha.

Funciona na perfeição como poderão testar. Segue o código:

Private Sub Copiar_Click()
'Copia linhas selecionadas para a Folha Resultados neste Livro

 Dim SourceRange As Range
Dim DestRange As Range
Dim Lr As Long
Lr = LastRow(Sheets("Resultados")) + 1
Set SourceRange = Sheets("Registos").Cells( _
ActiveCell.Row, 1).Range("D1:Y1")
	With SourceRange
	Set DestRange = Sheets("Resultados").Range("D" _
	& Lr).Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = SourceRange.Value
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
						After:=sh.Range("A1"), _
						Lookat:=xlPart, _
						LookIn:=xlFormulas, _
						SearchOrder:=xlByRows, _
						SearchDirection:=xlPrevious, _
						MatchCase:=False).Row
On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
						After:=sh.Range("A1"), _
						Lookat:=xlPart, _
						LookIn:=xlFormulas, _
						SearchOrder:=xlByColumns, _
						SearchDirection:=xlPrevious, _
						MatchCase:=False).Column
On Error GoTo 0
End Function

Ora o que eu gostaria de saber, e para isso preciso de ajuda, era como fazer o mesmo, mas copiando as linhas para uma folha situada noutro livro (Livro2).

Já tentei de diversas maneiras mas não dá.

Tenho o seguinte código que abre e fecha o outro livro (Livro2.xls), mas copia sempre a mesma linha.

Private Sub Copiar2_Click()
'Copia linhas selecionadas para a Folha Resultados no Livro 2
Dim SourceRange As Range
Dim DestRange As Range
Dim DestWB As Workbook
Dim DestSh As Worksheet
Dim Lr As Long

With Application
	.ScreenUpdating = False
	.EnableEvents = False
End With

'Change the file name (2*) and the path/file name to your file
If bIsBookOpen_RB("Livro2.xls") Then
	Set DestWB = Workbooks("Livro2.xls")
Else
	Set DestWB = Workbooks.Open("C:\Users\Antonio Gralhas\Desktop\Teste\Livro2.xls")
End If

'Change the Source Sheet and range
Set SourceRange = Range("D1:Q1")
'Change the sheet name of the database workbook
Set DestSh = DestWB.Worksheets("Resultados")


Lr = LastRow(DestSh)
Set DestRange = DestSh.Range("D" & Lr + 1)

'We make DestRange the same size as SourceRange and use the Value
'property to give DestRange the same values
With SourceRange
	Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = SourceRange.Value

DestWB.Close savechanges:=True

With Application
	.ScreenUpdating = True
	.EnableEvents = True
End With
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
						After:=sh.Range("A1"), _
						Lookat:=xlPart, _
						LookIn:=xlFormulas, _
						SearchOrder:=xlByRows, _
						SearchDirection:=xlPrevious, _
						MatchCase:=False).Row
On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
						After:=sh.Range("A1"), _
						Lookat:=xlPart, _
						LookIn:=xlFormulas, _
						SearchOrder:=xlByColumns, _
						SearchDirection:=xlPrevious, _
						MatchCase:=False).Column
On Error GoTo 0
End Function


Function bIsBookOpen_RB(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen_RB = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Ficaria imensamente grato se alguém me pudesse ajudar a resolver este problema, pois preciso do código par terminar um trabalho que estou a desenvolver.

Se necessário posso enviar os ficheiros para melhor observação.

Obrigado e cumprimentos a todos,

Antonio Gralhas

Edited June 6, 2013 by Rui Carlos
Formatação do código.

[jtiagodias 0]

Estou a ver este código e acho que pode encaixar na perfeição em algo que eu preciso...

Tenho numa folha de cálculo (Base de dados) uma série de informação.

Mas queria colocar noutra folha (em linhas contínuas) apenas as linhas que correspondam aos critérios que o utilizador pretende.

Este código só utiliza as linhas que o utilizador selecciona certo?

O meu obrigado desde já.

[jtiagodias 0]

Já estive a testar e este código é fantástico. Parabéns e obrigado Angra2011 porque acredito que vá ser útil e muitos utilizadores que, como eu, não têm um conhecimento muito profundo de VBA mas gostam de tentar simplificar o seu dia-a-dia com umas macros simples.

Só tenho 1 dúvida grande em relação a este código:

i) como é que com este código (copiar linhas para outra folha dentro do mesmo ficheiro) consigo que ele comece a escrever a partir de uma linha pré-definida (por exemplo a parte da célula A10...;

A outra questão (bem mais complexa) é como é que neste código conseguiria incluir um ciclo (por exemplo for) para verificar uma condição e sempre que essa condição se verificasse ele automaticamente pegava em cada linha que verificasse a condição e colava sequencialmente tal e qual está agora a fazer...

Muito obrigado.