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
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.
Hope this helps!Code: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
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.
Quote:
Originally Posted by Domenic
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.
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.
In that case, try...
Hope this helps!Code: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
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?
Quote:
Originally Posted by Domenic
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?
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
Quote:
Originally Posted by Domenic
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...
withCode:With Worksheets(ShtIndx)
Does this help?Code:With Sheets(ShtIndx)
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
Quote:
Originally Posted by Domenic
Yes, that's right. Does it help? I suspect that it won't, in which case I'll provide you with an alternative approach.
It sets about copy/pasting but returns #REF! for the sheets that have been renamed in the source still.
Quote:
Originally Posted by Domenic
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.
No rush I really appreciate it. What do you mean by code name?
Quote:
Originally Posted by Domenic
Earlier you mentioned...
The code name is Sheet#. So will the code name be the same for both the source and destination workbooks?Code:Sheet# (Name)
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.
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...
Code:Ribbon > Developer > Macro Security > Macro Settings > select/check Trust access to the VBA project object model
Hope this helps!Code: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).Properties("Name")))
Set wksDest = wkbDest.Worksheets(CStr(wkbDest.VBProject.VBComponents(vCodeName).Properties("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
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:
Quote:
Originally Posted by Domenic
Try...
Hope this helps!Code: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).Properties("Name")))
Set wksDest = wkbDest.Worksheets(CStr(wkbDest.VBProject.VBComponents(vCodeName).Properties("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
Does the trick! Thanks a million!