PDA

View Full Version : Solved: Copy Rows to another Sheet in another Workbook



AMRG2013
06-08-2013, 09:44 AM
The code below allows to copy the values ​​from the selected row of a sheet ("Registos") to another sheet ("Resultados"), within the same workbook ("Livro1.xls").
So, each time I select the row, it is copied to the sheet, always to the next row of that sheet.
Works perfectly as I could test.
Here is the code:

Private Sub Copiar_Click()
'Copy selected rows to the sheet "Resultados" in this workbook.

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



I would like to know, and for that I need help, is doing the same, but copying selected rows to the sheet ("Resultados"), but in another workbook (Livro2.xls).
I've tried several ways but it does not work as in the previous example.
I have the following code that opens and closes the other workbook (Livro2.xls), but this always copies the same row.

This is the code I have:

Private Sub Copiar2_Click()
'Copy selected rows to the sheet "Resultados" in workbook ("Livro2.xls")
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:Y1")

'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
On Error Resume Next
bIsBookOpen_RB = Not (Application.Workbooks(szBookName) Is Nothing)
End Function


I would be most grateful if someone could help me to solve this problem, because I need the code to finish the work I'm developing.
Bellow are the attached file to your appreciation.


Thank you for all

p45cal
06-08-2013, 10:13 AM
In the first snippet you set the source range thus:
Set SourceRange = Sheets("Registos").Cells(ActiveCell.Row, 1).Range("D1:Y1") In the second snippet you only have:
Set SourceRange = Range("D1:Y1")
The Range("D1:Y1") will always be in row 1 of the active sheet (unless the code is in a sheet's code-module in which case it will always be in row 1 of that sheet)

If the sheet you want to copy from is the active sheet when you start running the code, then it pays to set the sourcerange early, because opening a new book will probably change the active sheet.

So you could Set the Sourcerange very early in the code with
Set Sourcerange = activesheet.Cells(ActiveCell.Row, 1).Range("D1:Y1")


As an aside, I note you have a comment:"'Copy selected rows to the sheet "Resultados" in workbook ("Livro2.xls")" with rows in the plural. Both these snippets only copy the row of the active cell, that is, one row only. If you wanted to copy multiple rows you'd need something different.

AMRG2013
06-08-2013, 01:21 PM
The sheet "Resultados" in Livro2.xls is equal to the sheet "Resultados" in Livro1.xlsm.
What I intend to do in Livro2.xls is the same as I do for the Livro1.xlsm, ie copy row after row to the sheet "Resultados" in Livro2.xls, as I select any row with the mouse on the sheet "Registos", in Livro1.xlsm.
You can try using the workbook in attachment (Livro1.xlsm), to see how it works.

Bellow is the Livro2.xls in attached file to your appreciation.
I will be grateful if you can send me this information in attached files.
Thank you very much for your attention

p45cal
06-09-2013, 06:16 AM
try the attached.

AMRG2013
06-09-2013, 07:57 AM
Yes!!! That's what I wanted. The file works beautifully.
You are a genius...
Thanks again for your attention, and the help.
My regards,
AMRG2013