I have multiple xlsx file(which are not opened). I want to copy selected range value of each Workbook to the single row

Question

I have multiple workbooks each having the same sheet. I want to Copy the sheet's value to the master book.

I want to copy the selected range value of each Workbook to the single row of the new workbook.

Also, how can I retrieve the options button caption from the source workbook? Where Option buttons are ActiveX and linked cells.

If the options button is checked, copy the options button caption value to the destination cell.

Also I wish to add yyyy , mm,dd values in Date format (yyyy/mm/dd)

Sub test1()
    Dim Wsh As New IWshRuntimeLibrary.WshShell
    Dim result As WshExec
    Dim fileData() As String
    Dim path As String
    Dim cmd As String
    path = ThisWorkbook.path & "\Book1"
    cmd = "dir" & path & "/Test"
    Set result = Wsh.Exec("%ComSpec% /c" & cmd)
    Do While result.Status = 0
        DoEvents
    Loop
    fileData = Split(result.StdOut.ReadAll, vbCrLf)
    Dim i As Long
    i = 4
    For Each strData In fileData
        Cells(i, 2).Value = strData

        If Cells(i, 2).Value <> "" Then

            Cells(i, 3).Value = "='" & path & "\[" & strData & "]sheet1'!F1" '
            Cells(i, 4).Value = "='" & path & "\[" & strData & "]sheet1'!C4" '

        End If
        i = i + 1
    Next
End Sub

I get an error and can not retrieve the options button value to the destination workbook. — Learner77, Oct 06 '22 at 05:45
“I get an error” … and that error is? When you’re asking for help, provide as much information as humanly possible so that those trying to help have the best chance at doing so. — Skin, Oct 06 '22 at 05:58
Sorry ! runtime error '13' Type mismatch on the line " For Each strData In fileData " — Learner77, Oct 06 '22 at 06:06
Then add the error detail into the original question, people are not going to scan the comments in the hope you have explained the issue better there. — Solar Mike, Oct 06 '22 at 06:28
If you have to get just 1 value from a closed workbook then you may want to see [ExecuteExcel4Macro to get value from closed workbook](https://stackoverflow.com/questions/9259862/executeexcel4macro-to-get-value-from-closed-workbook) — Siddharth Rout, Oct 06 '22 at 06:47
Are the option buttons ActiveX, or Forms-type controls? Do they have linked cells? — Tim Williams, Oct 06 '22 at 06:53
How is defined strData? In For Each... loops, the loop variable must be Variant is the group is an array. — Vincent G, Oct 06 '22 at 07:12
you define FileDate but are using FileData in the loop. It is best to always use the Option Explicit statement to avoid this kind of errors — Vincent G, Oct 06 '22 at 07:14

score 0 · Accepted Answer · answered Oct 06 '22 at 12:18

Retrieve Data From Closed Workbooks 2

Sub RetrieveDataFromClosedWorkbooks2()
    
    Const SOURCE_SUBFOLDER_NAME As String = "Book1"
    Const SOURCE_FILE_PATTERN As String = "*.xlsx"
    Const SOURCE_WORKSHEET_NAME As String = "Sheet1"
    Const SOURCE_CELL_ADDRESSES_LIST As String = "F1,C4"
    
    Const DESTINATION_WORKSHEET_NAME As String = "Sheet1"
    Const DESTINATION_FIRST_CELL_ADDRESS As String = "B4"
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook
    Dim dws As Worksheet: Set dws = dwb.Worksheets(DESTINATION_WORKSHEET_NAME)
    Dim dCell As Range: Set dCell = dws.Range(DESTINATION_FIRST_CELL_ADDRESS)
    
    Dim pSep As String: pSep = Application.PathSeparator
    Dim sFolderPath As String
    sFolderPath = dwb.Path & pSep & SOURCE_SUBFOLDER_NAME
    If Right(sFolderPath, 1) <> pSep Then sFolderPath = sFolderPath & pSep
    
    Dim sFileNames() As String
    sFileNames = FileNamesToArray(sFolderPath, SOURCE_FILE_PATTERN)
    
    If UBound(sFileNames) = -1 Then
        MsgBox "No files found.", vbExclamation
        Exit Sub
    End If
    
    Dim sAddresses() As String
    sAddresses = Split(SOURCE_CELL_ADDRESSES_LIST, ",")
    
    Dim sf As Long
    Dim sa As Long
    Dim dFormula As String
    
    For sf = 0 To UBound(sFileNames)
        dCell.Offset(sf).Value = sFileNames(sf) ' source file name
        For sa = 0 To UBound(sAddresses)
            dFormula = "='" & sFolderPath & "[" & sFileNames(sf) _
                & "]" & SOURCE_WORKSHEET_NAME & "'!" & sAddresses(sa)
            'Debug.Print dFormula
            With dCell.Offset(sf, sa + 1)
                'Debug.Print .Address, sf, sFileNames(sf), sa, sAddresses(sa)
                .Formula = dFormula
                '.Value = .Value ' to keep only values
            End With
        Next sa
    Next sf

    MsgBox "Data retrieved.", vbInformation

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the names of all files of a folder in an array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function FileNamesToArray( _
    ByVal FolderPath As String, _
    Optional ByVal FilePattern As String = "*.*") _
As String()
    Const DirSwitches As String = "/b/a-d"
    
    Dim pSep As String: pSep = Application.PathSeparator
    If Right(FolderPath, 1) <> pSep Then FolderPath = FolderPath & pSep
    
    Dim ExecString As String ' '%comspec%' or 'cmd.exe' ?
    ExecString = "%comspec% /c Dir """ _
        & FolderPath & FilePattern & """ " & DirSwitches
    
    Dim pString As String
    pString = CreateObject("WScript.Shell").Exec(ExecString).StdOut.ReadAll
    
    If Len(pString) = 0 Then ' multiple issues: no file, invalid input(s)
        FileNamesToArray = Split("") ' ensure string array: 'LB = 0, UB = -1'
    Else
        pString = Left(pString, Len(pString) - 2) ' remove trailing 'vbCrLf'
        FileNamesToArray = Split(pString, vbCrLf)
    End If

End Function

Thank You. It is working if I need to display Option1 on the destination range value when option1 is selected. what should I have to do? other things remain the same. — Learner77, Oct 07 '22 at 01:01

I have multiple xlsx file(which are not opened). I want to copy selected range value of each Workbook to the single row

1 Answers1

Retrieve Data From Closed Workbooks 2