Accessing cells in different files in a folder

L

LaRana

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
 
B

Barb Reinhardt

In order to help you, I need to know the following:

1. What do [A1] and [A2] refer to? Cell addresses or something else
2. Do you want to copy the data to the sheet that's active when you start
the macro?

I'd define the active sheet as follows:

Dim aWS as worksheet

set aWS = activesheet

I'd define the sheet you'r getting data from as WS, but I"m not sure what it
is.

To set a range on aWS to be equal to something on WS, do this

aWS.cells(1,2).value = ws.cells(2,3).value


HTH,
Barb Reinhardt
 
D

Dave Peterson

[A1] is shorthand for activesheet.range("a1")

Turns out that this ([A1]) may be quicker to type, but it takes more time when
the macro runs.





Barb said:
In order to help you, I need to know the following:

1. What do [A1] and [A2] refer to? Cell addresses or something else
2. Do you want to copy the data to the sheet that's active when you start
the macro?

I'd define the active sheet as follows:

Dim aWS as worksheet

set aWS = activesheet

I'd define the sheet you'r getting data from as WS, but I"m not sure what it
is.

To set a range on aWS to be equal to something on WS, do this

aWS.cells(1,2).value = ws.cells(2,3).value

HTH,
Barb Reinhardt

LaRana said:
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
 
D

Dave Peterson

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.


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
 
L

LaRana

Thanks Barb, I will play with this a little more...

Barb Reinhardt said:
In order to help you, I need to know the following:

1. What do [A1] and [A2] refer to? Cell addresses or something else
2. Do you want to copy the data to the sheet that's active when you start
the macro?

I'd define the active sheet as follows:

Dim aWS as worksheet

set aWS = activesheet

I'd define the sheet you'r getting data from as WS, but I"m not sure what it
is.

To set a range on aWS to be equal to something on WS, do this

aWS.cells(1,2).value = ws.cells(2,3).value


HTH,
Barb Reinhardt

LaRana said:
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
 
L

LaRana

Thanks Dave, the code compiles and runs...However, it does override the cell
contents of the Dest cell range ( I only see data for the last sheet on my
destination worksheet). Here is more specifics on the from to files:

1.- I want to copy data from the 2nd sheet on the source
Workbook...(Otherwokbk)
2.- The cells I want to copy from the OtherWkBk sheet from are:
-- b5, e5,l5,l42,f49,l44
3.- the destination file is in a rows and column with a header. I guess we
can start copying from a2,a3,a4,a5,a6 and then next row...

Thanks Dave/



Dave Peterson said:
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.


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
 
L

LaRana

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 said:
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.


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
 
D

Dave Peterson

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


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 said:
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.


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
 
L

LaRana

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 said:
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 said:
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.


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
 
L

LaRana

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

Dave Peterson said:
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


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 said:
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
 
D

Dave Peterson

I changed the destination cells--A, B, C holds other junk. The real data starts
in D.
My mistake! yes, the destination should be in a2,b2,c2...let me test...

Dave Peterson said:
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


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.

:

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top