[RESOLVED] [Excel] Copy data from specific cells to another workbook

Hi,

I'm having a specific request that's driving me crazy for now a couple of days.

I'm advance in excel but it's been years since I work code in VB.

The problem I'm facing is that my Coworker want to have specific data that's spaced out on his spreadsheet to be copied into a separate workbook to keep track of work being done at work.

I've been lurking around Google but just can't find anything close to what I need the code to do.

I've attached a screenshot of the tables I need to copy.

The cells I need to copy to the new workbook are F6,F8,F10,F12,F14,P28,F36

I would be good if they were copied as a row and not as a column as well.

Thanks in advance

Welcome to VBforums:wave:

If you have both WorkBooks open and called Source and Destination(as WorkBook):

Code:

---


Destination.Sheets(1).cells(2,2)=Source.Sheets(1).Cells(6,6) 'Copies F6 inot Cell B2 of Destination-WorkBook Sheet81) Cell B2
Destination.Sheets(1).cells(2,3)=Source.Sheets(1).Cells(8,6) 'Copies F8 inot Cell B3 of Destination-WorkBook Sheet81) Cell B2

---

Quote:

---

Originally Posted by opus

Welcome to VBforums:wave:

If you have both WorkBooks open and called Source and Destination(as WorkBook):

Code:

---


Destination.Sheets(1).cells(2,2)=Source.Sheets(1).Cells(6,6) 'Copies F6 inot Cell B2 of Destination-WorkBook Sheet81) Cell B2
Destination.Sheets(1).cells(2,3)=Source.Sheets(1).Cells(8,6) 'Copies F8 inot Cell B3 of Destination-WorkBook Sheet81) Cell B2

---

---

Thanks for the info, I only want the source worksheet to be opened and use a button to call the script.

The code below is where I currently am on this project:

Code:

---

Private Sub Button_Copy_Click()
Dim wbksour As Workbook
Dim wbkdes As Workbook
Dim strFirstFile As String
Dim strSecondFile As String

strFirstFile = "C:\Users\(Username)\Desktop\Schéma récap MG.xls"
strSecondFile = "C:\Users\(Username)\Desktop\Récup Info.xls"

Set wbksour = Workbooks(strFirstFile)
Set wbkdes = Workbook.Open(strSecondFile)
wbkdes.Sheets("Récup Info").Cells(1, 2) = wbksour.Sheets("Bon de Travaux").Cells(16, 28) 'Copies F6 into Cell B2 of wbkdes.Sheets("Récup Info")
wbkdes.Sheets("Récup Info").Cells(2, 3) = wbksour.Sheets("Bon de Travaux").Cells(8, 6) 'Copies F8 into Cell B3 of wbkdes.Sheets("Récup Info")
wbkdes.Save
wbkdes.Close
End Sub

---

The button in question is named Button_copy (to make it simple) and is already on the source worksheet that I need to copy.

I find myself stuck to inform the script that the source is the worksheet open (wbksour) so it can go to the next step that is to copy the cells to the destination worksheet (wbkdes).

When I run it, I get the error "9" Subscript out of range, it obviously has to do with the line Set wbksour = Workbooks(strFirstFile).

open workbooks are indexed by name, not path and name

vb Code:

strFirstFile = "Schéma récap MG.xls"

Quote:

---

Originally Posted by westconn1

open workbooks are indexed by name, not path and name

vb Code:

strFirstFile = "Schéma récap MG.xls"

---

Thanks for the info.

So, the code below now work like I want to. Now I need it to copy n+1 each time the button is pressed, so if the last row was Number 2 it needs to copy on row 3.

Code:

---

Private Sub Button_Copy_Click()
Dim wbksour As Workbook
Dim wbkdes As Workbook
Dim strFirstFile As String
Dim strSecondFile As String

strFirstFile = "Schéma récap MG.xls"
strSecondFile = "C:\Users\(Username)\Desktop\Récup Info.xls"

Set wbksour = Workbooks(strFirstFile)
Set wbkdes = Workbooks.Open(strSecondFile)
wbkdes.Sheets("Récup Info").Cells(2, 1) = wbksour.Sheets("Bon de Travaux").Cells(28, 16) 'Copies P28 into Cell A2 of wbkdes.Sheets("Récup Info")
wbkdes.Sheets("Récup Info").Cells(2, 2) = wbksour.Sheets("Bon de Travaux").Cells(6, 6) 'Copies F6 into Cell B2 of wbkdes.Sheets("Récup Info")
wbkdes.Sheets("Récup Info").Cells(2, 3) = wbksour.Sheets("Bon de Travaux").Cells(8, 6) 'Copies F8 into Cell C2 of wbkdes.Sheets("Récup Info")
wbkdes.Sheets("Récup Info").Cells(2, 4) = wbksour.Sheets("Bon de Travaux").Cells(10, 6) 'Copies F10 into Cell D2 of wbkdes.Sheets("Récup Info")
wbkdes.Sheets("Récup Info").Cells(2, 5) = wbksour.Sheets("Bon de Travaux").Cells(12, 6) 'Copies F12 into Cell E2 of wbkdes.Sheets("Récup Info")
wbkdes.Sheets("Récup Info").Cells(2, 6) = wbksour.Sheets("Bon de Travaux").Cells(14, 6) 'Copies F14 into Cell F2 of wbkdes.Sheets("Récup Info")
wbkdes.Save
wbkdes.Close
End Sub

---

As a note, is it possible to use a network patch to open the closed source?

Quote:

---

As a note, is it possible to use a network patch to open the closed source?

---

assuming this means PATH, then yes

Quote:

---

so if the last row was Number 2 it needs to copy on row 3

---

try like

vb Code:

nextrow = wbkdes.Sheets("Récup Info").cells(wbkdes.Sheets("Récup Info").rows.count, 1).end(xlup).row + 1
wbkdes.Sheets("Récup Info").Cells(nextrow, 1) = wbksour.Sheets("Bon de Travaux").Cells(28, 16)
' rest of code to fill cells

Quote:

---

Originally Posted by westconn1

assuming this means PATH, then yes

---

Yes, it was path and not patch.

Quote:

---

Originally Posted by westconn1

try like

vb Code:

nextrow = wbkdes.Sheets("Récup Info").cells(wbkdes.Sheets("Récup Info").rows.count, 1).end(xlup).row + 1
wbkdes.Sheets("Récup Info").Cells(nextrow, 1) = wbksour.Sheets("Bon de Travaux").Cells(28, 16)
' rest of code to fill cells

---

Ok, with this the code is working like clockwork.

Here's the overall code for others:

Code:

---

Private Sub Button_Copy_Click()
Dim wbksour As Workbook
Dim wbkdes As Workbook
Dim strFirstFile As String
Dim strSecondFile As String

strFirstFile = "Schéma récap MG.xls" 'Use the opened document as source
strSecondFile = "\\prc2507et001\IRFSSMP_31\IRFSS\_MAINTENANCE\Récup Info.xls" 'Path for destination document

Set wbksour = Workbooks(strFirstFile)
Set wbkdes = Workbooks.Open(strSecondFile)
nextrow = wbkdes.Sheets("Récup Info").Cells(wbkdes.Sheets("Récup Info").Rows.Count, 1).End(xlUp).Row + 1
wbkdes.Sheets("Récup Info").Cells(nextrow, 1) = wbksour.Sheets("Bon de Travaux").Cells(28, 16) 'Copies P28 into Cell A2 of wbkdes.Sheets("Récup Info")
wbkdes.Sheets("Récup Info").Cells(nextrow, 2) = wbksour.Sheets("Bon de Travaux").Cells(6, 6) 'Copies F6 into Cell B2 of wbkdes.Sheets("Récup Info")
wbkdes.Sheets("Récup Info").Cells(nextrow, 3) = wbksour.Sheets("Bon de Travaux").Cells(8, 6) 'Copies F8 into Cell C2 of wbkdes.Sheets("Récup Info")
wbkdes.Sheets("Récup Info").Cells(nextrow, 4) = wbksour.Sheets("Bon de Travaux").Cells(10, 6) 'Copies F10 into Cell D2 of wbkdes.Sheets("Récup Info")
wbkdes.Sheets("Récup Info").Cells(nextrow, 5) = wbksour.Sheets("Bon de Travaux").Cells(12, 6) 'Copies F12 into Cell E2 of wbkdes.Sheets("Récup Info")
wbkdes.Sheets("Récup Info").Cells(nextrow, 6) = wbksour.Sheets("Bon de Travaux").Cells(14, 6) 'Copies F14 into Cell F2 of wbkdes.Sheets("Récup Info")
wbkdes.Save 'Save the Destination worksheet
wbkdes.Close 'Close the Destination worksheet
End Sub

---