PDA

View Full Version : Copy data from a range of cells and sheets in a closed workbook



Jasen
10-03-2015, 12:16 PM
Hi!

I need a macro to copy a range of cells from a range of sheets from a closed workbook chosen by file browser and I'm not sure where to start.

C8:AG16, C19:AG21, C29:AG26, C29:AG32 from sheets 5:34 to the same locations in the current workbook.

Also from Sheets5:34 cell Q2 from the target workbook copied to the same sheet in the current workbook but to cell O2 instead.

My knowledge here is limited so any help would be appreciated! Thanks

Domenic
10-03-2015, 03:20 PM
The following code uses ExecuteExcel4Macro to retrieve the values from a closed workbook. With more than 30 sheets, though, you may find it somewhat slow. In any case, try adopting the following code and see how well it works for you. Note that it is assumed that the "current workbook" is the active workbook. Also, you should turn off screen updating, and include the appropriate error handling.


Option Explicit

Sub test()

Dim sFullName As String
Dim sPath As String
Dim sFile As String
Dim vRanges As Variant
Dim rRange As Range
Dim ShtIndx As Integer
Dim RngIndx As Integer
Dim r As Long
Dim c As Long

sFullName = "c:\users\domenic\desktop\sample.xlsm"

sPath = Left(sFullName, InStrRev(sFullName, "\"))

sFile = Mid(sFullName, InStrRev(sFullName, "\") + 1)

vRanges = Array("C8:AG16", "C19:AG21", "C29:AG26", "C29:AG32")

For ShtIndx = 5 To 34
With Worksheets(ShtIndx)
For RngIndx = 0 To UBound(vRanges)
Set rRange = .Range(vRanges(RngIndx))
For r = 1 To rRange.Rows.Count
For c = 1 To rRange.Columns.Count
rRange(r, c).Value = GetValue(sPath, sFile, .Name, rRange(r, c).Address(, , xlR1C1))
.Range("O2").Value = GetValue(sPath, sFile, .Name, .Range("Q2").Address(, , xlR1C1))
Next c
Next r
Next RngIndx
End With
Next ShtIndx

End Sub

Private Function GetValue(sPath, sFile, sSheet, sRef)
Dim sArg As String
If Right(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If
sArg = "'" & sPath & "[" & sFile & "]" & sSheet & "'!" & sRef
GetValue = ExecuteExcel4Macro(sArg)
End Function

Hope this helps!

Jasen
10-03-2015, 03:30 PM
Thanks for the reply.

It is prompting me to select file for each cell that is copied. I had to force close excel otherwise I'd have a whole load of cancel buttons to hit haha.


The following code uses ExecuteExcel4Macro to retrieve the values from a closed workbook. With more than 30 sheets, though, you may find it somewhat slow. In any case, try adopting the following code and see how well it works for you. Note that it is assumed that the "current workbook" is the active workbook. Also, you should turn off screen updating, and include the appropriate error handling.


Option Explicit

Sub test()

Dim sFullName As String
Dim sPath As String
Dim sFile As String
Dim vRanges As Variant
Dim rRange As Range
Dim ShtIndx As Integer
Dim RngIndx As Integer
Dim r As Long
Dim c As Long

sFullName = "c:\users\domenic\desktop\sample.xlsm"

sPath = Left(sFullName, InStrRev(sFullName, "\"))

sFile = Mid(sFullName, InStrRev(sFullName, "\") + 1)

vRanges = Array("C8:AG16", "C19:AG21", "C29:AG26", "C29:AG32")

For ShtIndx = 5 To 34
With Worksheets(ShtIndx)
For RngIndx = 0 To UBound(vRanges)
Set rRange = .Range(vRanges(RngIndx))
For r = 1 To rRange.Rows.Count
For c = 1 To rRange.Columns.Count
rRange(r, c).Value = GetValue(sPath, sFile, .Name, rRange(r, c).Address(, , xlR1C1))
.Range("O2").Value = GetValue(sPath, sFile, .Name, .Range("Q2").Address(, , xlR1C1))
Next c
Next r
Next RngIndx
End With
Next ShtIndx

End Sub

Private Function GetValue(sPath, sFile, sSheet, sRef)
Dim sArg As String
If Right(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If
sArg = "'" & sPath & "[" & sFile & "]" & sSheet & "'!" & sRef
GetValue = ExecuteExcel4Macro(sArg)
End Function

Hope this helps!

Domenic
10-03-2015, 03:39 PM
That's because it can't find the specified file. You'll need to assign the string variable sFullName the appropriate filename. You mentioned that you're using a file browser to select the file. So assign the selected file to the variable sFullName.

Jasen
10-03-2015, 03:44 PM
Oh sorry, I meant I need the macro to let me/the user choose the file as I need to send out an updated version of a workbook to multiple people and they will have different filenames/locations for the target. I should have given more detail.

Domenic
10-03-2015, 04:22 PM
In that case, try...


sFullName = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xlsx;*.xlsm;*.xlsb;*.xls), *.xlsx;*.xlsm;*.xlsb;*.xls", _
Title:="Select a File", _
ButtonText:="Select")

If sFullName = "False" Then Exit Sub



Hope this helps!

Jasen
10-04-2015, 12:40 AM
So close!

That sorts out the file selection and it goes and pastes everything in the right place etc. Only issue seems to be that if the sheets don't share the same name on the source as the target then all I get is #REF! on the target workbook. They are all the same sheet number but the sheetnames will vary from user to user. If this is causing the issue then the sheetnames are on a sheet called "Targets" on the source workbook cells B4:B33.

Thanks so much for your help so far, I wouldn't have had a clue where to start. Any websites or books you can recommend I look into to pick this up?


In that case, try...


sFullName = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xlsx;*.xlsm;*.xlsb;*.xls), *.xlsx;*.xlsm;*.xlsb;*.xls", _
Title:="Select a File", _
ButtonText:="Select")

If sFullName = "False" Then Exit Sub



Hope this helps!

Domenic
10-04-2015, 07:56 AM
Sorry, but I'm a bit confused. How are we going to refer to the worksheets for both the source and destination workbooks? Are we going to refer to them by sheet name (ie. Sheet5, Sheet6, Sheet7 ... Sheet54)? By their index number (ie. 5, 6, 7 ... 54)? Or something else? Can you please elaborate?

Jasen
10-04-2015, 01:00 PM
Apologies. I am confusing myself and am mostly self taught so don't know a lot of the correct terminology.

The sheetnames will not be the same on the source and destination as the source will have had data input into it that has dynamically updated the names of the sheets. So I assume index number is what I mean - in the VBA project explorer they are listed as Sheet# (Name) and I'm referring to the Sheet# due to the sheet name being different for the different end users that this will be needed by. Does that make sense? I'm a noob with VBA so I don't know what I'm restricted by to make this work. Thanks for your patience :D




Sorry, but I'm a bit confused. How are we going to refer to the worksheets for both the source and destination workbooks? Are we going to refer to them by sheet name (ie. Sheet5, Sheet6, Sheet7 ... Sheet54)? By their index number (ie. 5, 6, 7 ... 54)? Or something else? Can you please elaborate?

Domenic
10-04-2015, 01:52 PM
Actually, in my code, I do refer to the worksheets by index number. But maybe I should have used the Sheets collection, instead of the Worksheets collection. Try replacing...


With Worksheets(ShtIndx)

with


With Sheets(ShtIndx)

Does this help?

Jasen
10-04-2015, 02:06 PM
So, like this?

Option Explicit

Sub test()

Dim sFullName As String
Dim sPath As String
Dim sFile As String
Dim vRanges As Variant
Dim rRange As Range
Dim ShtIndx As Integer
Dim RngIndx As Integer
Dim r As Long
Dim c As Long

sFullName = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xlsx;*.xlsm;*.xlsb;*.xls), *.xlsx;*.xlsm;*.xlsb;*.xls", _
Title:="Select a File", _
ButtonText:="Select")

If sFullName = "False" Then Exit Sub

sPath = Left(sFullName, InStrRev(sFullName, "\"))

sFile = Mid(sFullName, InStrRev(sFullName, "\") + 1)

vRanges = Array("C8:AG16", "C19:AG21", "C29:AG26", "C29:AG32")

For ShtIndx = 5 To 34
With Sheets(ShtIndx)
For RngIndx = 0 To UBound(vRanges)
Set rRange = .Range(vRanges(RngIndx))
For r = 1 To rRange.Rows.Count
For c = 1 To rRange.Columns.Count
rRange(r, c).Value = GetValue(sPath, sFile, .Name, rRange(r, c).Address(, , xlR1C1))
.Range("O2").Value = GetValue(sPath, sFile, .Name, .Range("Q2").Address(, , xlR1C1))
Next c
Next r
Next RngIndx
End With
Next ShtIndx

End Sub

Private Function GetValue(sPath, sFile, sSheet, sRef)
Dim sArg As String
If Right(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If
sArg = "'" & sPath & "[" & sFile & "]" & sSheet & "'!" & sRef
GetValue = ExecuteExcel4Macro(sArg)
End Function






Actually, in my code, I do refer to the worksheets by index number. But maybe I should have used the Sheets collection, instead of the Worksheets collection. Try replacing...


With Worksheets(ShtIndx)

with


With Sheets(ShtIndx)

Does this help?

Domenic
10-04-2015, 02:16 PM
Yes, that's right. Does it help? I suspect that it won't, in which case I'll provide you with an alternative approach.

Jasen
10-04-2015, 02:28 PM
It sets about copy/pasting but returns #REF! for the sheets that have been renamed in the source still.


Yes, that's right. Does it help? I suspect that it won't, in which case I'll provide you with an alternative approach.

Domenic
10-04-2015, 02:50 PM
Okay, so it looks like we won't be able to refer to the sheets by index number. So if I understand you correctly, the code name (not the sheet name) will be the same for both the source and destination workbooks, correct? While the sheet names will differ, correct?

Once you confirm the above, I'll provide you with an alternative. However, it looks like I won't get a chance until sometime later this evening.

Jasen
10-04-2015, 02:53 PM
No rush I really appreciate it. What do you mean by code name?


Okay, so it looks like we won't be able to refer to the sheets by index number. So if I understand you correctly, the code name (not the sheet name) will be the same for both the source and destination workbooks, correct? While the sheet names will differ, correct?

Once you confirm the above, I'll provide you with an alternative. However, it looks like I won't get a chance until sometime later this evening.

Domenic
10-04-2015, 03:08 PM
Earlier you mentioned...


Sheet# (Name)

The code name is Sheet#. So will the code name be the same for both the source and destination workbooks?

Jasen
10-04-2015, 03:19 PM
Yep the work books will be basically the same, the sheet names will just vary for Sheet5 to Sheet34 for the the different sources. They are named "1" through to "30" in the destination and the multiple end-users' sources' sheet names will vary depending on the names of people in a sales team. They're all Sheet5 (Person1), Sheet6 (Person2), Sheet7 (Person3) and so on, essentially.

Domenic
10-04-2015, 07:33 PM
In the following code, add other code names for your sheets, where indicated. Also, you'll need to allow access to the VBProject object model...


Ribbon > Developer > Macro Security > Macro Settings > select/check Trust access to the VBA project object model


Option Explicit

Sub RetrieveValues()

Dim sFullName As String
Dim wkbSource As Workbook
Dim wksSource As Worksheet
Dim wkbDest As Workbook
Dim wksDest As Worksheet
Dim vCodeNames As Variant
Dim vCodeName As Variant
Dim vRanges As Variant
Dim RngIndx As Integer

sFullName = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xlsx;*.xlsm;*.xlsb;*.xls), *.xlsx;*.xlsm;*.xlsb;*.xls", _
Title:="Select a File", _
ButtonText:="Select")

If sFullName = "False" Then Exit Sub

Application.ScreenUpdating = False

On Error GoTo ErrHandler

Set wkbDest = ActiveWorkbook

Set wkbSource = Workbooks.Open(Filename:=sFullName, ReadOnly:=True)

vCodeNames = Array("Sheet5", "Sheet6", "Sheet7") 'add other code names accordingly

vRanges = Array("C8:AG16", "C19:AG21", "C29:AG26", "C29:AG32")

For Each vCodeName In vCodeNames
Set wksSource = wkbSource.Worksheets(CStr(wkbSource.VBProject.VBComponents(vCodeName).Prope rties("Name")))
Set wksDest = wkbDest.Worksheets(CStr(wkbDest.VBProject.VBComponents(vCodeName).Propertie s("Name")))
For RngIndx = 0 To UBound(vRanges)
wksDest.Range(vRanges(RngIndx)).Value = wksSource.Range(vRanges(RngIndx)).Value
Next RngIndx
wksDest.Range("O2").Value = wksSource.Range("Q2").Value
Next vCodeName

wkbSource.Close savechanges:=False

ExitSub:
Application.ScreenUpdating = True
Set wkbSource = Nothing
Set wkbDest = Nothing
Set wksDest = Nothing
Exit Sub

ErrHandler:
MsgBox "Error " & Err.Number & ":" & Chr(10) & Chr(10) & Err.Description
Resume ExitSub

End Sub

Hope this helps!

Jasen
10-04-2015, 10:25 PM
Total superstar it works a charm! Many many thanks.
Can I be a total pain in the rear end and ask if it's possible to add in:
The copying of Sheet1 in its entirety,
Cells C2 and A4:C33 of Sheet 2
Cell Q2 of Sheet4 copied to Cell O2 of destination Sheet4?

Then I'll leave you alone I promise :bow:


In the following code, add other code names for your sheets, where indicated. Also, you'll need to allow access to the VBProject object model...


Ribbon > Developer > Macro Security > Macro Settings > select/check Trust access to the VBA project object model


Option Explicit

Sub RetrieveValues()

Dim sFullName As String
Dim wkbSource As Workbook
Dim wksSource As Worksheet
Dim wkbDest As Workbook
Dim wksDest As Worksheet
Dim vCodeNames As Variant
Dim vCodeName As Variant
Dim vRanges As Variant
Dim RngIndx As Integer

sFullName = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xlsx;*.xlsm;*.xlsb;*.xls), *.xlsx;*.xlsm;*.xlsb;*.xls", _
Title:="Select a File", _
ButtonText:="Select")

If sFullName = "False" Then Exit Sub

Application.ScreenUpdating = False

On Error GoTo ErrHandler

Set wkbDest = ActiveWorkbook

Set wkbSource = Workbooks.Open(Filename:=sFullName, ReadOnly:=True)

vCodeNames = Array("Sheet5", "Sheet6", "Sheet7") 'add other code names accordingly

vRanges = Array("C8:AG16", "C19:AG21", "C29:AG26", "C29:AG32")

For Each vCodeName In vCodeNames
Set wksSource = wkbSource.Worksheets(CStr(wkbSource.VBProject.VBComponents(vCodeName).Prope rties("Name")))
Set wksDest = wkbDest.Worksheets(CStr(wkbDest.VBProject.VBComponents(vCodeName).Propertie s("Name")))
For RngIndx = 0 To UBound(vRanges)
wksDest.Range(vRanges(RngIndx)).Value = wksSource.Range(vRanges(RngIndx)).Value
Next RngIndx
wksDest.Range("O2").Value = wksSource.Range("Q2").Value
Next vCodeName

wkbSource.Close savechanges:=False

ExitSub:
Application.ScreenUpdating = True
Set wkbSource = Nothing
Set wkbDest = Nothing
Set wksDest = Nothing
Exit Sub

ErrHandler:
MsgBox "Error " & Err.Number & ":" & Chr(10) & Chr(10) & Err.Description
Resume ExitSub

End Sub

Hope this helps!

Domenic
10-05-2015, 08:33 AM
Try...


Option Explicit

Sub RetrieveValues()

Dim sFullName As String
Dim wkbSource As Workbook
Dim wksSource As Worksheet
Dim wkbDest As Workbook
Dim wksDest As Worksheet
Dim vCodeNames As Variant
Dim vCodeName As Variant
Dim vRanges As Variant
Dim RngIndx As Integer

sFullName = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xlsx;*.xlsm;*.xlsb;*.xls), *.xlsx;*.xlsm;*.xlsb;*.xls", _
Title:="Select a File", _
ButtonText:="Select")

If sFullName = "False" Then Exit Sub

Application.ScreenUpdating = False

On Error GoTo ErrHandler

Set wkbDest = ActiveWorkbook

Set wkbSource = Workbooks.Open(Filename:=sFullName, ReadOnly:=True)

' Retrieve values from sheet with the code name Sheet1
Set wksSource = wkbSource.Worksheets(CStr(wkbSource.VBProject.VBComponents("Sheet1").Properties("Name")))
Set wksDest = wkbDest.Worksheets(CStr(wkbDest.VBProject.VBComponents("Sheet1").Properties("Name")))
With wksSource.UsedRange
wksDest.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With

' Retrieve values from sheet with the code name Sheet2
Set wksSource = wkbSource.Worksheets(CStr(wkbSource.VBProject.VBComponents("Sheet2").Properties("Name")))
Set wksDest = wkbDest.Worksheets(CStr(wkbDest.VBProject.VBComponents("Sheet2").Properties("Name")))
wksDest.Range("C2").Value = wksSource.Range("C2").Value
wksDest.Range("A4:C33").Value = wksSource.Range("A4:C33").Value

' Retrieve value from sheet with the code name Sheet4
Set wksSource = wkbSource.Worksheets(CStr(wkbSource.VBProject.VBComponents("Sheet4").Properties("Name")))
Set wksDest = wkbDest.Worksheets(CStr(wkbDest.VBProject.VBComponents("Sheet4").Properties("Name")))
wksDest.Range("O2").Value = wksSource.Range("Q2").Value

' Retrieve values from sheets with code names Sheet5 to Sheet34
vCodeNames = Array("Sheet5", "Sheet6") 'add other code names accordingly
vRanges = Array("C8:AG16", "C19:AG21", "C29:AG26", "C29:AG32")
For Each vCodeName In vCodeNames
Set wksSource = wkbSource.Worksheets(CStr(wkbSource.VBProject.VBComponents(vCodeName).Prope rties("Name")))
Set wksDest = wkbDest.Worksheets(CStr(wkbDest.VBProject.VBComponents(vCodeName).Propertie s("Name")))
For RngIndx = 0 To UBound(vRanges)
wksDest.Range(vRanges(RngIndx)).Value = wksSource.Range(vRanges(RngIndx)).Value
Next RngIndx
wksDest.Range("O2").Value = wksSource.Range("Q2").Value
Next vCodeName

wkbSource.Close savechanges:=False

ExitSub:
Application.ScreenUpdating = True
Set wkbSource = Nothing
Set wkbDest = Nothing
Set wksDest = Nothing
Exit Sub

ErrHandler:
MsgBox "Error " & Err.Number & ":" & Chr(10) & Chr(10) & Err.Description
Resume ExitSub

End Sub

Hope this helps!

Jasen
10-06-2015, 01:39 PM
Does the trick! Thanks a million!