I changed the destination cells--A, B, C holds other junk. The real data starts
in D.

LaRana wrote:

My mistake! yes, the destination should be in a2,b2,c2...let me test...

"Dave Peterson" wrote:

I see no pattern for pasting into a2, b3, c4, c5, ... I don't know what to
guess next.

But when I do this kind of thing, I put the values all in one row:
a2, b2, c2, d2, e2
then come down a row.

And if one of those cells is empty (the one that determines the destcell), then
the destcell won't be set correctly and you'll be overwriting data
(potentially).

So I make sure I put something in the column that always has data--the
date/time, the workbook or worksheet name -- anything...

Still untested, but it did compile:

Option Explicit
Sub GetMyData()

Dim MyFile As String
Dim MyWks As Worksheet
Dim OtherWkbk As Workbook
Dim OtherWks As Worksheet
Dim Directory As String
Dim RngToCopy As Range
Dim DestCell As Range
Dim myAddresses As Variant
Dim aCtr As Long

myAddresses = Array("b5", "e5", "l6", "l42", "l44", "f49")

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)
Set OtherWks = OtherWkbk.Worksheets(1)

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

With DestCell
'date/time in column A
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
.Value = Now

'workbook name in B
.Offset(0, 1).Value = OtherWkbk.FullName

'worksheet name in C
.Offset(0, 2).NumberFormat = "@"
.Offset(0, 2).Value = OtherWks.Name

'data in D:whatever
For aCtr = LBound(myAddresses) To UBound(myAddresses)
.Offset(0, 3 + aCtr).Value _
= OtherWks.Range(myAddresses(aCtr)).Value
Next aCtr
End With

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"

End Sub



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


--

Dave Peterson


--

Dave Peterson