Dave and Barb:

The folllowing code runs succesfully!!! Thanks Guys!

however I would like the following:
1.- for the code to respect my hearder row in the destination WorkBK (row 1)
2.- for the code to skip rows if it finds data in the row. I am planning to
do several runs, and would like to keep accumulating data as I run...without
overriding the exiting rows in the destination workbook (OtherWkbk)
-----------------------------------------------------------
Option Explicit
Sub GetMyData()

Dim MyFile As String
Dim MyWks As Worksheet
Dim OtherWkbk As Workbook
Dim Directory As String
Dim RngToCopy As Range
Dim DestCell As Range
Dim row1 As Integer

Set MyWks = ActiveSheet 'not the workbook

'change this to the directory for your files
Directory = "S:\Test-Rap\"

MyFile = Dir(Directory & "\*.xls")
row1 = 2
Do Until MyFile = ""
Set OtherWkbk = Workbooks.Open(Directory & MyFile)
'With OtherWkbk.Worksheets(2) 'first worksheet in that workbook?

MyWks.Cells(row1, 1).Value = OtherWkbk.Worksheets(2).Cells(5, 2).Value
MyWks.Cells(row1, 2).Value = OtherWkbk.Worksheets(2).Cells(5, 5).Value
MyWks.Cells(row1, 3).Value = OtherWkbk.Worksheets(2).Cells(44,
12).Value
row1 = row1 + 1
'End With

OtherWkbk.Close savechanges:=False
MyFile = Dir
Loop

'this directory must exist or it will give an error
MyWks.Parent.SaveCopyAs "S:combined1.xls" '<--added .xls

End Sub


3.Regarding enabling macros...Can I override this message somehow without
manually clicking OK?



3.- There is a message from the OtherWorkbook

"LaRana" wrote:

Thanks Dave, the code runs, but it does override the contents of the dest
file. In other works, I only see data for the last OtherWkBk.

Here are more specifics:
1. I want to copy cell contents from the second sheet in the OtherWkBk
2. I want to copy contents of cells :b5,e5,l6,l42,l44,f49
3. My Destination file is in columns and rows format, so I guess we can
start copying data at a2,b3,c4,c5... and next file, and copy to next row...

Thanks Dave.


"Dave Peterson" wrote:

Maybe...

Option Explicit
Sub GetMyData()

Dim MyFile As String
Dim MyWks As Worksheet
Dim OtherWkbk As Workbook
Dim Directory As String
Dim RngToCopy As Range
Dim DestCell As Range

Set MyWks = ActiveSheet 'not the workbook

'change this to the directory for your files
Directory = "S:\Test-Rap\"

MyFile = Dir(Directory & "\*.xls")
Do Until MyFile = ""
Set OtherWkbk = Workbooks.Open(Directory & MyFile)
With OtherWkbk.Worksheets(1) 'first worksheet in that workbook?
Set RngToCopy = .Range("a2", .Range("a1").End(xlDown).Offset(0, 3))
End With

With MyWks
If IsEmpty(.Range("a2").Value) Then
Set DestCell = .Range("a2")
ElseIf IsEmpty(.Range("a3").Value) Then
Set DestCell = .Range("a3")
Else
Set DestCell = .Range("a2").End(xlDown).Offset(1, 0)
End If
End With

'you have a couple of choices
DestCell.Resize(RngToCopy.Rows.Count, RngToCopy.Columns.Count).Value _
= RngToCopy.Value

'or
RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlPasteValues

OtherWkbk.Close savechanges:=False
MyFile = Dir
Loop

'this directory must exist or it will give an error
MyWks.Parent.SaveCopyAs "S:\Test-Rap\combined.xls" '<--added .xls

End Sub


This compiled, but I didn't test it.



LaRana wrote:

Hello,
Can anyone help to modify this code to read/copy specific cell data from the
myfile and send it or assign it to my active workbook? my active workbook
will be my "master" workbook where I'll be gathering all data. The "myfile"
(source files) are not in a columns and rows format, therefore I need to type
specific cell references. ( the "master" file will in in a row and column
format)

My code open the file succesfully, but I don't know how to code for specific
cells...
If anyone can give me a sample of how to code for an spefic cell and then
code to assign it to my active workbook, then I can follow...
ex : master.loan ("a1) = myfile.sheets("sheet1").cell ('b2")
I am not sure about the syntax...

Option Explicit
Dim MyFile As String
Dim MyWkBk As String
Dim Directory As String
Dim LstCell As String

Sub GetMyData()
MyWkBk = ActiveWorkbook.Name
Directory = "S:\Test-Rap\" 'change this to the directory for your files
MyFile = Dir(Directory & "\*.xls")
Do Until MyFile = ""
Workbooks.Open (Directory & MyFile)
LstCell = [A1].End(xlDown).Offset(0, 3).Address
Range("A2", LstCell).Copy
Workbooks(MyWkBk).Activate
If [A2].Value = "" Then
[A2].Activate
Else
[A2].End(xlDown).Offset(1, 0).Activate
End If
ActiveCell.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Workbooks(MyFile).Close (False)
MyFile = Dir
Loop

ActiveWorkbook.SaveCopyAs "S:\Test-Rap\combined" 'this directory must
'exist or it will give an error
End Sub

--

Dave Peterson