View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Accessing cells in different files in a folder

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