macro amendment (collation of data)

[jaypatel]

Hi,

I have the following script (with help of mrexcel.com, thanks):

Sub test()

Dim strPath As String
Dim strFile As String
Dim wkbOpen As Workbook
Dim wksOpen As Worksheet
Dim wkbDest As Workbook
Dim wksDest As Worksheet
Dim NextRow As Long

Application.ScreenUpdating = False

Set wkbDest = ActiveWorkbook
Set wksDest = ActiveSheet

strPath = "C:\Documents and Settings\jpatel\My Documents\macro extraction"

If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

strFile = Dir(strPath & "*.xls*")

With wksDest
NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

Do While Len(strFile) > 0
If strFile <> wkbDest.Name Then
Set wkbOpen = Workbooks.Open(Filename:=strPath & strFile)
Set wksOpen = wkbOpen.Worksheets("sheet1") 'Change the sheet name accordingly
With wksOpen
.Cells(4, "c").Copy Destination:=wksDest.Cells(NextRow, "A")
.Cells(4, "d").Copy Destination:=wksDest.Cells(NextRow, "B")
.Cells(3, "g").Copy Destination:=wksDest.Cells(NextRow, "C")
wksDest.Cells(NextRow, "D").Value = .Cells(5, "c").Value
.Cells(4, "g").Copy Destination:=wksDest.Cells(NextRow, "e")
End With
wkbOpen.Close savechanges:=False
NextRow = NextRow + 1
End If
strFile = Dir
Loop

Application.ScreenUpdating = True

End Sub

but, i need to extract, certain cells in column c in column A, cells in column D in column B, cells in Column E in column C etc. ie Cell C4 in A1, cell C5 in A2, cell in C6 in A3, and correspondingly, Cell D4 in B1, Cell D5 in B2.

Can you help.

Regards

Jay