PDA

View Full Version : Macro to copy data from one workbook to another.



CMC6
11-01-2014, 12:40 PM
Hello,
I'm trying to write a macro that will copy the same range (L18:L22) in all the sheets within one workbook, and copy into one sheet in another workbook. I need the data from the first sheet in the source book to copy into column A of the destination book, the data from the second sheet into column B and so on. I need the data to copy into the next available row of each column (i.e. if A4 has data, copy to A5). I'm stuck, but here is the code I have so far:

Sub TorqueData()
Dim wbSrc As Workbook
Dim wbDest As Workbook
Dim lastrow As Long

Dim strFilePath As String
strFilePath = "C:\..."

Dim strFileNameDest As String
strFileNameDest = "Master Calibration Data - Num10.xlsm"
Dim strFileNameSrc As String
strFileNameSrc = "Opta Comms Export.xlsm"

Set wbDest = Workbooks.Open(Filename:=strFilePath & Dir$(strFilePath & strFileNameDest))
Set wbSrc = Workbooks.Open(Filename:=strFilePath & Dir$(strFilePath & strFileNameSrc))

wbSrc.Activate
For Each sh In wbSrc.Sheets
wbSrc.Sheets(sh).Range("L18:L22").Copy
wbDest.Sheets("Sheet1").Activate
lastrow = wbDest.Sheets("Sheet1").Range("A" & wbDest.Sheets("Sheets1").Rows.Count).End(xlUp).Row + 1
wbDest.Sheets("Sheet1").Range("A" & lastrow).PasteSpecial xlPasteValues

Next
End Sub

p45cal
11-01-2014, 02:49 PM
untested, try:
Sub TorqueData()
Dim wbSrc As Workbook, wbDest As Workbook
Dim sh As Worksheet
Dim strFileNameDest As String, strFileNameSrc As String, strFilePath As String
Dim DestnColmNo As Long

strFilePath = "C:\..."
strFileNameDest = "Master Calibration Data - Num10.xlsm"
strFileNameSrc = "Opta Comms Export.xlsm"

Set wbDest = Workbooks.Open(Filename:=strFilePath & Dir$(strFilePath & strFileNameDest))
Set wbSrc = Workbooks.Open(Filename:=strFilePath & Dir$(strFilePath & strFileNameSrc))

DestnColmNo = 1
For Each sh In wbSrc.Sheets
With wbDest.Sheets("Sheet1")
.Cells(.Rows.Count, DestnColmNo).End(xlUp).Offset(1).Resize(5).Value = sh.Range("L18:L22").Value
End With
DestnColmNo = DestnColmNo + 1
Next sh
End Sub

CMC6
11-02-2014, 04:00 PM
Thanks for your assistance. I tried it out but it wouldn't copy or paste any of the data. I tried working through that portion of the code but didn't have any luck.


untested, try:
Sub TorqueData()
Dim wbSrc As Workbook, wbDest As Workbook
Dim sh As Worksheet
Dim strFileNameDest As String, strFileNameSrc As String, strFilePath As String
Dim DestnColmNo As Long

strFilePath = "C:\..."
strFileNameDest = "Master Calibration Data - Num10.xlsm"
strFileNameSrc = "Opta Comms Export.xlsm"

Set wbDest = Workbooks.Open(Filename:=strFilePath & Dir$(strFilePath & strFileNameDest))
Set wbSrc = Workbooks.Open(Filename:=strFilePath & Dir$(strFilePath & strFileNameSrc))

DestnColmNo = 1
For Each sh In wbSrc.Sheets
With wbDest.Sheets("Sheet1")
.Cells(.Rows.Count, DestnColmNo).End(xlUp).Offset(1).Resize(5).Value = sh.Range("L18:L22").Value
End With
DestnColmNo = DestnColmNo + 1
Next sh
End Sub

p45cal
11-02-2014, 04:44 PM
I can't help without some clues; where does it go wrong? Are there any error messages?
I presume you've not left the line:
strFilePath = "C:\..."
as-is.
Have you stepped through the code (with F8) while looking at the Locals panel (alt+v, s if you can't see it) to check that variables are properly assigned?

CMC6
11-03-2014, 06:35 AM
Sorry, to be more specific: I did update the file path, that works fine and it opens the destination workbook but nothing else happens, no errors. I did step into the code and initially it would only step through to the "Set wbDest = ..." portion and then would automatically execute the rest of the code and I couldn't debug the rest. I manually moved the yellow arrow ahead, and then finally it gave me an error at the "For Each sh..." line: Run-time error '91': Object variable or With block variable not set. I'm obviously a novice and do not know how to correct it.
I appreciate you taking the time to assist.

p45cal
11-06-2014, 04:17 AM
Will look at this on Friday

p45cal
11-08-2014, 05:12 AM
I have tested the code with actual files and it seems to work fine here with no errors.

I'm not sure why you have:
Workbooks.Open(Filename:=strFilePath & Dir$(strFilePath & strFileNameDest))
instead of the simpler:
Workbooks.Open(Filename:=strFilePath & strFileNameDest)
but it shouldn't matter.

This is the code as tested:
Sub TorqueData()
Dim wbSrc As Workbook, wbDest As Workbook
Dim sh As Worksheet
Dim strFileNameDest As String, strFileNameSrc As String, strFilePath As String
Dim DestnColmNo As Long

strFilePath = "C:\Users\zzz\Documents\"
strFileNameDest = "Master Calibration Data - Num10.xlsm"
strFileNameSrc = "Opta Comms Export.xlsm"

Set wbDest = Workbooks.Open(Filename:=strFilePath & Dir$(strFilePath & strFileNameDest))
Set wbSrc = Workbooks.Open(Filename:=strFilePath & Dir$(strFilePath & strFileNameSrc))

DestnColmNo = 1
For Each sh In wbSrc.Sheets
With wbDest.Sheets("Sheet1")
.Cells(.Rows.Count, DestnColmNo).End(xlUp).Offset(1).Resize(5).Value = sh.Range("L18:L22").Value
End With
DestnColmNo = DestnColmNo + 1
Next sh
End Sub
The error you got would be expected if the Set wbDest = line hasn't properly executed.

The code you're executing is in a third file, that is, not in either of the files referred to in the code, isn't it?
I also note that both source and destination files are xlsm files; do they have code that executes oin opening?
We might be able to stop this with something like Application.AutomationSecurity=msoAutomationSecurityForceDisable but I haven't explored this yet.

(Unable to reply yesterday as the vbaexpress site was down for a lot longer than the 15 minutes or less it said it would be down for!)

CMC6
11-10-2014, 05:16 PM
I changed the Dest and Src file types so they're not xlsm (I removed a macro from each that I no longer needed, and forgot I still had in there). I also had the files on a network location, I moved them back to my hard drive and updated the file path to match. After that, the code worked perfectly.

I can't thank you enough for your help, this has saved me a significant amount of time every single week.

Thanks again, your time and generosity is very appreciated. Cheers