Macro to copy data from a set of excel files

[Sreejesh Menon]

i need to copy specific cell from a set of files inisde a folder and need to be pasted one below other,

folder. e:\billing\bill\imported
cells to copy j4, b5, j10, c4
and j4 value to be pasted in a column of result sheet one below another, b5 on b column, j10 on c column and following. please help me

[Excel Fox]

Sreejesh, is this only one folder, or does it include sub folders also? will there be excel workbooks only in that folder? and what about the master workbook? will this also be inside this folder?

[Sreejesh Menon]

it is only one folder, no sub folder and only excel work books. master also inside same folder

[Admin]

Hi Sreejesh,

Welcome to ExcelFox !!

try this


Sub kTest()

Dim wbkSource As Workbook
Dim wbkMaster As Workbook
Dim wksMaster As Worksheet
Dim Dest As Range
Dim FName As String
Dim i As Long
Dim k(), x

'// User settings
Const MyFolder = "E:\billing\bill\imported\"
Const MyCells = "J4,B5,J10,C4"
Const MasterSht = "Sheet1"
'End

If Len(Dir(MyFolder, vbDirectory)) Then
Set wbkMaster = ThisWorkbook
On Error Resume Next
Set wksMaster = wbkMaster.Worksheets(MasterSht)
If Err.Number <> 0 Then
MsgBox "Master sheet '" & MasterSht & "' couldn't found", vbInformation
Err.Clear
Exit Sub
End If
On Error GoTo 0
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Set Dest = wksMaster.Range("a" & wksMaster.Rows.Count).End(3)(2)
x = Split(MyCells, ",")
ReDim k(UBound(x))

FName = Dir(MyFolder & "*.xls*")
Do While FName <> vbNullString
If FName <> wbkMaster.Name Then
Set wbkSource = Workbooks.Open(MyFolder & FName, 0)
With wbkSource.Worksheets(1)
For i = 0 To UBound(x)
k(i) = .Range(CStr(x(i))).Value
Next
End With
wbkSource.Close 0
Set wbkSource = Nothing
Dest.Resize(, UBound(x) + 1) = k
Set Dest = Dest(2)
End If
FName = Dir()
Loop
End If
With Application
.ScreenUpdating = 1
.DisplayAlerts = 1
End With

End Sub

[Sreejesh Menon]

this is working thanks a lot

[Admin]

You are welcome and thanks for the feedback :cheers: