Open 40 files at once and copy paste special values

[praveenlal]

I have 40 different files with same format. I want to open all 40 files at once and copy paste special values in 2 cells. Can anyone help with it.

 

[ranman256]

something similar to this , that opens all xl files in 1 folder (given in cell D7)
then opens all and copies src cell to target cell.

Dim wbSrc As Workbook, wb As Workbook
Const kTargCell = "C4"
  'goto source file to copy from
 
Workbooks.Open "c:\temp\mySource.xls"
Set wbSrc = ActiveWorkbook
  'open all wb's in 1 folder
OpenAllFilesInDir Range("D7").Value
'goto each wb and paste
For Each wb In Workbook
    wbSrc.Activate
    Range(kTargCell).Copy
   
    wb.Activate
    Range(kTargCell).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    wb.Close True
Next
Set wb = Nothing
Set wbSrc = Nothing
End Sub

Private Sub OpenAllFilesInDir(ByVal pvDir)
Dim vFil, vTargT
Dim i As Integer
Dim sSql As String
Dim db 'As Database
Dim fso
Dim oFolder, oFile
On Error GoTo errImp
If Right(pvDir, 1) <> "\" Then pvDir = pvDir & "\"
'sTBL = "xlFile"
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(pvDir)
For Each oFile In oFolder.Files
    vFil = oFile.Name
    If InStr(vFil, ".xls") > 0 Then      'ONLY DO EXCEL FILES
       Workbooks.Open oFile
    End If
Next
Set db = Nothing
Set fso = Nothing
Set oFile = Nothing
Set oFolder = Nothing
Exit Sub
errImp:
MsgBox Err.Description, vbCritical, "ImportAllFilesInDir():" & Err
End Sub