Pregunta

I have one master workbook and 20 other workbooks in a SharePoint. Currently I am using the following code to retrive a single cell value from the closed workbook which is working very fine.

Sub Example()

Dim wbPath As String, wbName As String
Dim wsName As String, cellRef As String
Dim Ret As String

wbPath = "http://*****/2014/"

wbName = "overview 2014.xlsm"
wsName = "Sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("Sheet1").Range("A4").Value = ExecuteExcel4Macro(Ret)

End Sub

Now I actually wanted to get the same cell value which needs to be copied from all workbooks from the SharePoint into the Master workbook ranges A5, A6, A7, A8.... etc.

Can some one please help me or give me a hint on how to copy same cell values from different closed workbooks from the same sharepoint location?

I have actually tried with the following code for other workbooks and working fine, but just wanted to know is there any other smarter way to reduce number of lines in the code?

 wbPath = "http://*****/2014/"

 wbName = "overview 2014.xlsm"
 wsName = "Sheet1"
 cellRef = "E2"

 Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)

ActiveWorkbook.Worksheets("sheet1").Range("A4").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook2.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A5").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook3.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A6").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook4.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A7").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook5.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A8").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook6.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A9").Value = ExecuteExcel4Macro(Ret)

wbName = "Workbook7.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A10").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook8.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A11").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook9.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A13").Value = ExecuteExcel4Macro(Ret)

wbName = "workbook10.xlsm"
wsName = "sheet1"
cellRef = "E2"

Ret = "'" & wbPath & "[" & wbName & "]" & _
      wsName & "'!" & Range(cellRef).Address(True, True, -4150)

ActiveWorkbook.Worksheets("sheet1").Range("A14").Value = ExecuteExcel4Macro(Ret)
¿Fue útil?

Solución

To reduce the code I would use additional function:

Function getValue(wbPath As String, wbName As String, wsName As String, cellRef As String)
    Dim Ret As String
    Ret = "'" & wbPath & "[" & wbName & "]" & _
            wsName & "'!" & Range(cellRef).Address(True, True, -4150)
    getValue = ExecuteExcel4Macro(Ret)
End Function

and then call it like this:

Sub test()
    Dim i As Integer, wbs

    wbs = Array("overview 2014.xlsm", "workbook2.xlsm", _
                "workbook3.xlsm", "workbook4.xlsm", _
                "workbook5.xlsm", "workbook6.xlsm", _
                "workbook7.xlsm", "workbook8.xlsm", _
                "workbook9.xlsm", "workbook10.xlsm")
    ' LBound(wbs) = 0
    For i = LBound(wbs) To UBound(wbs)
        ActiveWorkbook.Worksheets("sheet1").Range("A4").Offset(i).Value = _
            getValue("http://*****/2014/", CStr(wbs(i)), "sheet1", "E2")
    Next i
End Sub
Licenciado bajo: CC-BY-SA con atribución
No afiliado a StackOverflow
scroll top