Macro Help Please
 

Hi
I need to open all files in a specified directory and copy the contents of
A337:A383 ommitting every other cell (Blanks) and paste them into a new book
in a column starting in b1. The files are n ame myfileyymmdd.xls and I need
to copy in date order
Thanks!

Macro Help Please
 

Dim dt as Date, i as Long
Dim rng as Range, rw as Long
set sh1 = Activesheet
for i = 0 to 30
dt = dateSerial(2005,1,1)
set bk = Nothing
On Error Resume Next
set bk = Workbooks.Open("C:\MyFolder\MyFile" & _
format(dt + i,"yymmdd") & ".xls"
On Error goto 0
if not bk is nothing then
set rng = bk.worksheets(1).Range(A337:A383").SpecialCells(xl Constants)
rw = sh1.Cells(rows.count,2).End(xlup)
if rw < 1 then rw = rw + 1
rng.copy Destination:=Sh1.Cells(rw,2)
bk.close SaveChanges:=False
End if
Next

Change dateSerial to reflect the first day you want to copy from.

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the contents of
A337:A383 ommitting every other cell (Blanks) and paste them into a new
book
in a column starting in b1. The files are n ame myfileyymmdd.xls and I
need
to copy in date order
Thanks!

Macro Help Please
 

Thanks for the reply Tom
If I have the 'copy to' workbook in the directrory where the daily files are
stored how would I modify the code. I want to be able to copy this file to
the new month and then run it and not have to modify the path in the code
Thanks
Sandy

"Tom Ogilvy" wrote:

Dim dt as Date, i as Long
Dim rng as Range, rw as Long
set sh1 = Activesheet
for i = 0 to 30
dt = dateSerial(2005,1,1)
set bk = Nothing
On Error Resume Next
set bk = Workbooks.Open("C:\MyFolder\MyFile" & _
format(dt + i,"yymmdd") & ".xls"
On Error goto 0
if not bk is nothing then
set rng = bk.worksheets(1).Range(A337:A383").SpecialCells(xl Constants)
rw = sh1.Cells(rows.count,2).End(xlup)
if rw < 1 then rw = rw + 1
rng.copy Destination:=Sh1.Cells(rw,2)
bk.close SaveChanges:=False
End if
Next

Change dateSerial to reflect the first day you want to copy from.

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the contents of
A337:A383 ommitting every other cell (Blanks) and paste them into a new
book
in a column starting in b1. The files are n ame myfileyymmdd.xls and I
need
to copy in date order
Thanks!

Macro Help Please
 

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Constants)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the contents of
A337:A383 ommitting every other cell (Blanks) and paste them into a new
book
in a column starting in b1. The files are n ame myfileyymmdd.xls and I
need
to copy in date order
Thanks!

Macro Help Please
 

Im getting Run Time Error 76 Path not found on line:
Set oFolder = oFSO.GetFolder(sFolder)
Thanks!

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Constants)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the contents of
A337:A383 ommitting every other cell (Blanks) and paste them into a new
book
in a column starting in b1. The files are n ame myfileyymmdd.xls and I
need
to copy in date order
Thanks!

Macro Help Please
 

DUH!!!
I didnt change path! Still trying to figure that part out
Thanks!

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Constants)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the contents of
A337:A383 ommitting every other cell (Blanks) and paste them into a new
book
in a column starting in b1. The files are n ame myfileyymmdd.xls and I
need
to copy in date order
Thanks!

Macro Help Please
 

OK I changed sFolder = "C:\MyTest" to sFolder=ThisWorkbook.Path
And the code is opening the files. However it is not copying the range as
specified.
What did I do wrong?

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Formulas)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the contents of
A337:A383 ommitting every other cell (Blanks) and paste them into a new
book
in a column starting in b1. The files are n ame myfileyymmdd.xls and I
need
to copy in date order
Thanks!

Macro Help Please
 

Try this which caters for no data, and NG wrap

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
On Error Resume Next
Set rng = _
.Worksheets(1).Range("A337:A383").SpecialCells(xlC onstants)
On Error GoTo 0
If Not rng Is Nothing Then
iRow = oSh.Cells(Rows.Count, 2).End(xlUp).Row
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
End If
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub




--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...

OK I changed sFolder = "C:\MyTest" to sFolder=ThisWorkbook.Path
And the code is opening the files. However it is not copying the range as
specified.
What did I do wrong?

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Formulas)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the
contents of
A337:A383 ommitting every other cell (Blanks) and paste them into a
new
book
in a column starting in b1. The files are n ame myfileyymmdd.xls and I
need
to copy in date order
Thanks!

Macro Help Please
 

Change xlFormulas to xlConstants

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...

OK I changed sFolder = "C:\MyTest" to sFolder=ThisWorkbook.Path
And the code is opening the files. However it is not copying the range as
specified.
What did I do wrong?

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Formulas)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the
contents of
A337:A383 ommitting every other cell (Blanks) and paste them into a
new
book
in a column starting in b1. The files are n ame myfileyymmdd.xls and I
need
to copy in date order
Thanks!

Macro Help Please
 

The cells to be copied are populated with formulae, so shouldnt it be
xlformulas?
Thanks

"Tom Ogilvy" wrote:

Change xlFormulas to xlConstants

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...

OK I changed sFolder = "C:\MyTest" to sFolder=ThisWorkbook.Path
And the code is opening the files. However it is not copying the range as
specified.
What did I do wrong?

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Formulas)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the
contents of
A337:A383 ommitting every other cell (Blanks) and paste them into a
new
book
in a column starting in b1. The files are n ame myfileyymmdd.xls and I
need
to copy in date order
Thanks!

Macro Help Please
 

And we would know that how? So, yes, based on this new information - it
should stay xlFormulas

You said it wasn't copying anything, so that was my best guess. Otherwise,
it should copy as you described. Bob got the same impression I see.

--
Regards,
Tom Ogilvy

"Sandy" wrote in message
...
The cells to be copied are populated with formulae, so shouldnt it be
xlformulas?
Thanks

"Tom Ogilvy" wrote:

Change xlFormulas to xlConstants

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...

OK I changed sFolder = "C:\MyTest" to sFolder=ThisWorkbook.Path
And the code is opening the files. However it is not copying the
range as
specified.
What did I do wrong?

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Formulas)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the
contents of
A337:A383 ommitting every other cell (Blanks) and paste them into
a
new
book
in a column starting in b1. The files are n ame myfileyymmdd.xls
and I
need
to copy in date order
Thanks!

Macro Help Please
 

My most sincere apology for the omission...I am new here and to VBA I will
try to do better. However I am still having trouble getting anything but a
blank worksheet. I did discover (Another Omission) that my sheet is actually
sheet2 (named Daily) and have made that change to....

Set rng = .Worksheets(2).Range("A337:A383").SpecialCells(xlF ormulas)

and have also tried

Set rng =
..Worksheets("Daily").Range("A337:A383").SpecialCe lls(xlFormulas)

When I stop through the code the file opens but I dont see the range
actually selected. Should I?
NOw what?

Thanks for your help!
"Tom Ogilvy" wrote:

And we would know that how? So, yes, based on this new information - it
should stay xlFormulas

You said it wasn't copying anything, so that was my best guess. Otherwise,
it should copy as you described. Bob got the same impression I see.

--
Regards,
Tom Ogilvy

"Sandy" wrote in message
...
The cells to be copied are populated with formulae, so shouldnt it be
xlformulas?
Thanks

"Tom Ogilvy" wrote:

Change xlFormulas to xlConstants

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...

OK I changed sFolder = "C:\MyTest" to sFolder=ThisWorkbook.Path
And the code is opening the files. However it is not copying the
range as
specified.
What did I do wrong?

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Formulas)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the
contents of
A337:A383 ommitting every other cell (Blanks) and paste them into
a
new
book
in a column starting in b1. The files are n ame myfileyymmdd.xls
and I
need
to copy in date order
Thanks!

Macro Help Please
 

Im not sure what I did but I do have a good copy now. However the code is not
opening the files in the correct orde. Files are named myfileyymmdd.xls and
should open and copy in date order.
Thanks!

"Tom Ogilvy" wrote:

And we would know that how? So, yes, based on this new information - it
should stay xlFormulas

You said it wasn't copying anything, so that was my best guess. Otherwise,
it should copy as you described. Bob got the same impression I see.

--
Regards,
Tom Ogilvy

"Sandy" wrote in message
...
The cells to be copied are populated with formulae, so shouldnt it be
xlformulas?
Thanks

"Tom Ogilvy" wrote:

Change xlFormulas to xlConstants

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...

OK I changed sFolder = "C:\MyTest" to sFolder=ThisWorkbook.Path
And the code is opening the files. However it is not copying the
range as
specified.
What did I do wrong?

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Formulas)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the
contents of
A337:A383 ommitting every other cell (Blanks) and paste them into
a
new
book
in a column starting in b1. The files are n ame myfileyymmdd.xls
and I
need
to copy in date order
Thanks!

Macro Help Please
 

I offered a way to do that, so you might combine that approach with what you
have.

--
Regards,
Tom Ogilvy

"Sandy" wrote in message
...
Im not sure what I did but I do have a good copy now. However the code is
not
opening the files in the correct orde. Files are named myfileyymmdd.xls
and
should open and copy in date order.
Thanks!

"Tom Ogilvy" wrote:

And we would know that how? So, yes, based on this new information - it
should stay xlFormulas

You said it wasn't copying anything, so that was my best guess.
Otherwise,
it should copy as you described. Bob got the same impression I see.

--
Regards,
Tom Ogilvy

"Sandy" wrote in message
...
The cells to be copied are populated with formulae, so shouldnt it be
xlformulas?
Thanks

"Tom Ogilvy" wrote:

Change xlFormulas to xlConstants

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...

OK I changed sFolder = "C:\MyTest" to sFolder=ThisWorkbook.Path
And the code is opening the files. However it is not copying the
range as
specified.
What did I do wrong?

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Formulas)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the
contents of
A337:A383 ommitting every other cell (Blanks) and paste them
into
a
new
book
in a column starting in b1. The files are n ame
myfileyymmdd.xls
and I
need
to copy in date order
Thanks!

Macro Help Please
 

Or you can post what you have working and it could be modified to work with
the files in order.

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...
Im not sure what I did but I do have a good copy now. However the code is
not
opening the files in the correct orde. Files are named myfileyymmdd.xls
and
should open and copy in date order.
Thanks!

"Tom Ogilvy" wrote:

And we would know that how? So, yes, based on this new information - it
should stay xlFormulas

You said it wasn't copying anything, so that was my best guess.
Otherwise,
it should copy as you described. Bob got the same impression I see.

--
Regards,
Tom Ogilvy

"Sandy" wrote in message
...
The cells to be copied are populated with formulae, so shouldnt it be
xlformulas?
Thanks

"Tom Ogilvy" wrote:

Change xlFormulas to xlConstants

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...

OK I changed sFolder = "C:\MyTest" to sFolder=ThisWorkbook.Path
And the code is opening the files. However it is not copying the
range as
specified.
What did I do wrong?

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Formulas)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the
contents of
A337:A383 ommitting every other cell (Blanks) and paste them
into
a
new
book
in a column starting in b1. The files are n ame
myfileyymmdd.xls
and I
need
to copy in date order
Thanks!

Macro Help Please
 

This is what I have...

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = ThisWorkbook.Path
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=oFile.Path
With ActiveWorkbook
On Error Resume Next
Set rng =
..Worksheets(").Range("A337:A383").SpecialCells(xl Formulas)
On Error GoTo 0
If Not rng Is Nothing Then
iRow = oSh.Cells(Rows.Count, 2).End(xlUp).Row
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
End If
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub

The only changes I have made from Bob's solution is

xlconstants to xl formulas
sFolder = "C:\MyTest" to sFolder = ThisWorkbook.Path
Set rng =Worksheets(1).Range("A337:A383") to
Set rng =Worksheets(2).Range("A337:A383")

Thanks!



"Tom Ogilvy" wrote:

Or you can post what you have working and it could be modified to work with
the files in order.

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...
Im not sure what I did but I do have a good copy now. However the code is
not
opening the files in the correct orde. Files are named myfileyymmdd.xls
and
should open and copy in date order.
Thanks!

"Tom Ogilvy" wrote:

And we would know that how? So, yes, based on this new information - it
should stay xlFormulas

You said it wasn't copying anything, so that was my best guess.
Otherwise,
it should copy as you described. Bob got the same impression I see.

--
Regards,
Tom Ogilvy

"Sandy" wrote in message
...
The cells to be copied are populated with formulae, so shouldnt it be
xlformulas?
Thanks

"Tom Ogilvy" wrote:

Change xlFormulas to xlConstants

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...

OK I changed sFolder = "C:\MyTest" to sFolder=ThisWorkbook.Path
And the code is opening the files. However it is not copying the
range as
specified.
What did I do wrong?

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Formulas)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the
contents of
A337:A383 ommitting every other cell (Blanks) and paste them
into
a
new
book
in a column starting in b1. The files are n ame
myfileyymmdd.xls
and I
need
to copy in date order
Thanks!

Macro Help Please
 

Typo in working code....

Set rng = .Worksheets(2).Range("A337:A383").


"Sandy" wrote:

This is what I have...

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = ThisWorkbook.Path
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=oFile.Path
With ActiveWorkbook
On Error Resume Next
Set rng =
.Worksheets(").Range("A337:A383").SpecialCells(xlF ormulas)
On Error GoTo 0
If Not rng Is Nothing Then
iRow = oSh.Cells(Rows.Count, 2).End(xlUp).Row
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
End If
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub

The only changes I have made from Bob's solution is

xlconstants to xl formulas
sFolder = "C:\MyTest" to sFolder = ThisWorkbook.Path
Set rng =Worksheets(1).Range("A337:A383") to
Set rng =Worksheets(2).Range("A337:A383")

Thanks!



"Tom Ogilvy" wrote:

Or you can post what you have working and it could be modified to work with
the files in order.

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...
Im not sure what I did but I do have a good copy now. However the code is
not
opening the files in the correct orde. Files are named myfileyymmdd.xls
and
should open and copy in date order.
Thanks!

"Tom Ogilvy" wrote:

And we would know that how? So, yes, based on this new information - it
should stay xlFormulas

You said it wasn't copying anything, so that was my best guess.
Otherwise,
it should copy as you described. Bob got the same impression I see.

--
Regards,
Tom Ogilvy

"Sandy" wrote in message
...
The cells to be copied are populated with formulae, so shouldnt it be
xlformulas?
Thanks

"Tom Ogilvy" wrote:

Change xlFormulas to xlConstants

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...

OK I changed sFolder = "C:\MyTest" to sFolder=ThisWorkbook.Path
And the code is opening the files. However it is not copying the
range as
specified.
What did I do wrong?

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Formulas)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the
contents of
A337:A383 ommitting every other cell (Blanks) and paste them
into
a
new
book
in a column starting in b1. The files are n ame
myfileyymmdd.xls
and I
need
to copy in date order
Thanks!

Macro Help Please
 

Sandy,

The easiest way to get them to open in date order is to use a sensible
naming convention, that is, use a date format of yyyymmdd, and put that at
the start of the file not the end.

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Im not sure what I did but I do have a good copy now. However the code is
not
opening the files in the correct orde. Files are named myfileyymmdd.xls
and
should open and copy in date order.
Thanks!

"Tom Ogilvy" wrote:

And we would know that how? So, yes, based on this new information - it
should stay xlFormulas

You said it wasn't copying anything, so that was my best guess.
Otherwise,
it should copy as you described. Bob got the same impression I see.

--
Regards,
Tom Ogilvy

"Sandy" wrote in message
...
The cells to be copied are populated with formulae, so shouldnt it be
xlformulas?
Thanks

"Tom Ogilvy" wrote:

Change xlFormulas to xlConstants

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...

OK I changed sFolder = "C:\MyTest" to sFolder=ThisWorkbook.Path
And the code is opening the files. However it is not copying the
range as
specified.
What did I do wrong?

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Formulas)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy the
contents of
A337:A383 ommitting every other cell (Blanks) and paste them
into
a
new
book
in a column starting in b1. The files are n ame
myfileyymmdd.xls
and I
need
to copy in date order
Thanks!

Macro Help Please
 

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range
Dim v As Variant
Dim j As Long, k As Long
Dim sDate1 As String
Dim sDate2 As String
Dim temp As String
Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = ThisWorkbook.Path
If sFolder = "" Then Exit Sub
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
ReDim v(1 To oFolder.Files.Count)
i = 0
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" _
And LCase(oFile.Path) < LCase(ThisWorkbook.FullName) Then
i = i + 1
v(i) = oFile.Path
End If
Next
ReDim Preserve v(1 To i)
For j = 1 To UBound(v) - 1
For k = j + 1 To UBound(v)
sDate1 = Mid(v(j), Len(v(j)) - 9, 6)
sDate2 = Mid(v(k), Len(v(k)) - 9, 6)
If sDate2 < sDate1 Then
temp = v(k)
v(k) = v(j)
v(j) = temp
End If
Next
Next
For i = 1 To UBound(v)
Workbooks.Open Filename:=v(i)
With ActiveWorkbook
On Error Resume Next
Set rng = _
.Worksheets(2).Range("A337:A383") _
.SpecialCells(xlFormulas)
On Error GoTo 0
If Not rng Is Nothing Then
iRow = oSh.Cells(Rows.Count, 2).End(xlUp).Row
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
End If
.Close SaveChanges:=False
End With
Next i
End Sub

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...
Typo in working code....

Set rng = .Worksheets(2).Range("A337:A383").


"Sandy" wrote:

This is what I have...

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = ThisWorkbook.Path
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=oFile.Path
With ActiveWorkbook
On Error Resume Next
Set rng =
.Worksheets(").Range("A337:A383").SpecialCells(xlF ormulas)
On Error GoTo 0
If Not rng Is Nothing Then
iRow = oSh.Cells(Rows.Count, 2).End(xlUp).Row
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
End If
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub

The only changes I have made from Bob's solution is

xlconstants to xl formulas
sFolder = "C:\MyTest" to sFolder = ThisWorkbook.Path
Set rng =Worksheets(1).Range("A337:A383") to
Set rng =Worksheets(2).Range("A337:A383")

Thanks!



"Tom Ogilvy" wrote:

Or you can post what you have working and it could be modified to work
with
the files in order.

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...
Im not sure what I did but I do have a good copy now. However the
code is
not
opening the files in the correct orde. Files are named
myfileyymmdd.xls
and
should open and copy in date order.
Thanks!

"Tom Ogilvy" wrote:

And we would know that how? So, yes, based on this new
information - it
should stay xlFormulas

You said it wasn't copying anything, so that was my best guess.
Otherwise,
it should copy as you described. Bob got the same impression I
see.

--
Regards,
Tom Ogilvy

"Sandy" wrote in message
...
The cells to be copied are populated with formulae, so shouldnt
it be
xlformulas?
Thanks

"Tom Ogilvy" wrote:

Change xlFormulas to xlConstants

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...

OK I changed sFolder = "C:\MyTest" to
sFolder=ThisWorkbook.Path
And the code is opening the files. However it is not
copying the
range as
specified.
What did I do wrong?

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet"
Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =

...Worksheets(1).Range("A337:A383").SpecialCells(x lFormulas)
iRow = oSh.Cells(Rows.Count,
2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow,
2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and
copy the
contents of
A337:A383 ommitting every other cell (Blanks) and paste
them
into
a
new
book
in a column starting in b1. The files are n ame
myfileyymmdd.xls
and I
need
to copy in date order
Thanks!

Macro Help Please
 

Actually, if they all were named with the same prepended text before the
date as originally presented, then they would be in order.

--
Regards,
Tom Ogilvy

"Bob Phillips" wrote in message
...
Sandy,

The easiest way to get them to open in date order is to use a sensible
naming convention, that is, use a date format of yyyymmdd, and put that at
the start of the file not the end.

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Im not sure what I did but I do have a good copy now. However the code
is
not
opening the files in the correct orde. Files are named myfileyymmdd.xls
and
should open and copy in date order.
Thanks!

"Tom Ogilvy" wrote:

And we would know that how? So, yes, based on this new information -
it
should stay xlFormulas

You said it wasn't copying anything, so that was my best guess.
Otherwise,
it should copy as you described. Bob got the same impression I see.

--
Regards,
Tom Ogilvy

"Sandy" wrote in message
...
The cells to be copied are populated with formulae, so shouldnt it
be
xlformulas?
Thanks

"Tom Ogilvy" wrote:

Change xlFormulas to xlConstants

--
Regards,
Tom Ogilvy


"Sandy" wrote in message
...

OK I changed sFolder = "C:\MyTest" to sFolder=ThisWorkbook.Path
And the code is opening the files. However it is not copying
the
range as
specified.
What did I do wrong?

"Bob Phillips" wrote:

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = "C:\MyTest"
If sFolder < "" Then
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open FileName:=oFile.Path
With ActiveWorkbook
Set rng =
..Worksheets(1).Range("A337:A383").SpecialCells(xl Formulas)
iRow = oSh.Cells(Rows.Count, 2).End(xlUp)
If iRow < 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
.Close SaveChanges:=False
End With
End If
Next oFile

End If ' sFolder < ""

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sandy" wrote in message
...
Hi
I need to open all files in a specified directory and copy
the
contents of
A337:A383 ommitting every other cell (Blanks) and paste them
into
a
new
book
in a column starting in b1. The files are n ame
myfileyymmdd.xls
and I
need
to copy in date order
Thanks!