VBA to copy specified cells from all the files in a folder

[rakeshplb]

Hi All,

I have a folder "D:\Documents and Settings\Rakesh", which has many .xls files. Each file has a sheet called 'Cover Note'. I want to copy cells B2, C2, D4 and F3 from 'Cover Note' of each file.

These cells should be pasted in the current sheet - row 2 onwards. First cell of each row should have the source file name.

Please, can anybody help me. Thanks.

Rakesh

 

[nirvana_]

just change the sheet name in your code for the output. in column A it will tell if the sheet is found or not. files will be listed in col F.

Option Explicit
Public strSourceFldr As String
Public EachFile As Object
Public objFSO As Object
Public objFolder As Object
Public objFile As Object
Public strSheetName As String
Public strSrcCell1 As String
Public strSrcCell2 As String
Public strSrcCell3 As String
Public strSrcCell4 As String
Public intStartCell As Integer
Sub DataCopy()
    strSourceFldr = Worksheets(1).Cells(1, 14)
    strSheetName = "Sheet1"
    strSrcCell1 = "B2"
    strSrcCell2 = "C2"
    strSrcCell3 = "D4"
    strSrcCell4 = "F3"
    intStartCell = 2
    Set objFSO = CreateObject("Scripting.Filesystemobject")
    Set objFolder = objFSO.GetFolder(strSourceFldr)
    For Each EachFile In objFolder.Files
        If LCase(objFSO.GetExtensionName(EachFile)) = "xls" Then
            ProcessFile EachFile
        End If
    Next
    ProcessSubFolder objFSO.GetFolder(strSourceFldr)
End Sub
Sub ProcessFile(ByRef ThisFile As Object)
    Dim Cell1, Cell2, Cell3, Cell4, WS
    Dim strValidFile As String
    strValidFile = "Sheet " & strSheetName & " not found"
    Set objFile = objFSO.GetFile(ThisFile)
    Workbooks.Open ThisFile
    For Each WS In ActiveWorkbook.Worksheets
        If WS.Name = strSheetName Then
            strValidFile = ThisFile.Name
            Cell1 = Range(strSrcCell1).Value
            Cell2 = Range(strSrcCell2).Value
            Cell3 = Range(strSrcCell3).Value
            Cell4 = Range(strSrcCell4).Value
        End If
    Next
    ActiveWorkbook.Close
    Worksheets(1).Cells(intStartCell, 1) = strValidFile
    Worksheets(1).Cells(intStartCell, 2) = Cell1
    Worksheets(1).Cells(intStartCell, 3) = Cell2
    Worksheets(1).Cells(intStartCell, 4) = Cell3
    Worksheets(1).Cells(intStartCell, 5) = Cell4
    Worksheets(1).Cells(intStartCell, 6) = ThisFile.Path
    intStartCell = intStartCell + 1
End Sub
Sub ProcessSubFolder(ByRef ThisFolder As Object)
    Dim SubFolder
    For Each SubFolder In ThisFolder.SubFolders
        Set objFolder = objFSO.GetFolder(SubFolder.Path)
        For Each EachFile In objFolder.Files
            If LCase(objFSO.GetExtensionName(EachFile)) = "xls" Then
                ProcessFile EachFile
            End If
        Next
        ProcessSubFolder objFolder
    Next
End Sub

 

[rakeshplb]

Nirvana! you are wonderful!!!!

just a last peice if i need to change it sometime in future. How I can change the cells to be copied? Say instead of "B2", "C2", "D4" and "F3", I want to copy A1, A2, A3, A4 A5 and AX100.

I think Ineed to change here -

strSrcCell1 = "B2"
strSrcCell2 = "C2"
strSrcCell3 = "D4"
strSrcCell4 = "F3"

Here -
Cell1 = Range(strSrcCell1).Value
Cell2 = Range(strSrcCell2).Value
Cell3 = Range(strSrcCell3).Value
Cell4 = Range(strSrcCell4).Value

And Here -

Worksheets(1).Cells(intStartCell, 2) = Cell1
Worksheets(1).Cells(intStartCell, 3) = Cell2
Worksheets(1).Cells(intStartCell, 4) = Cell3
Worksheets(1).Cells(intStartCell, 5) = Cell4

Is that right?

Can you provide me a brief guidance, if you can spare a few moments for me.

 

[nirvana_]

This is your source cell which is B2,C2,D4 and F3 which is copied from the sheet e.g. Reconciliation.

strSrcCell1 = "B2"
strSrcCell2 = "C2"
strSrcCell3 = "D4"
strSrcCell4 = "F3"

--------------

Dont worry about this bit of code. It is not necessary.

Cell1 = Range(strSrcCell1).Value
Cell2 = Range(strSrcCell2).Value
Cell3 = Range(strSrcCell3).Value
Cell4 = Range(strSrcCell4).Value

---------------

You only need to worry about lines below.

Worksheets(1).Cells(intStartCell, 1) = strValidFile
Worksheets(1).Cells(intStartCell, 2) = Cell1
Worksheets(1).Cells(intStartCell, 3) = Cell2
Worksheets(1).Cells(intStartCell, 4) = Cell3
Worksheets(1).Cells(intStartCell, 5) = Cell4
Worksheets(1).Cells(intStartCell, 6) = ThisFile.Path

Here the numbers 1,2,3,4,5,6 marked in red represent column number i.e. Column A,B,C,D,E and F. intStartCell is = 2 in this program which mean it will use Row number 2 to paste the data.

Which means the data will be pasted into A2, B2, C2, D2, E2 and F2. After that the next file will be written below it.

You can change the numbers 1,2,3,4,5 and 6 depending on which column you need your data into. Also the same with intStartCell to change the row number in the begining of the program.

 

[rakeshplb]

Many thanks Dear!