Copy Macro

[Guest]

Hello

I am trying to modify existing code to accomplish the following: Copy range
bp18:bu18 from sheet1 of a daily file and paste to a new montyhly summary
sheet B2:B6, with a new row for for each day. There are 2 files created each
day myfileyyyymmddA.xls and myfileyyyymmddP.xls. I would like to only copy
from the "A" file. This is the code I have but it copies A and P and is
pasting in Column A only.

Sub Summary()

Dim myCell As Range

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Copy or move this workbook to the folder with
'the files that you want to summarize
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> ThisWorkbook.FullName Then
Set myBook = Workbooks.Open(.FoundFiles(i))
myBook.Worksheets("sheet1").Select
For Each myCell In _
Intersect(ActiveSheet.Range("BP18:BU18"),
ActiveSheet.UsedRange)
If myCell.Value <> 0 Then
ThisWorkbook.Worksheets(1). _
Range("A65536").End(xlUp)(2).Value = _
myCell.Value
End If
Next myCell
myBook.Close
End If
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

Basebook.SaveAs Application.GetSaveAsFilename

End Sub

Thanks!
Al

 

[Tom Ogilvy]

How many files will be in ThisWorkbookPath. Just 3. the file with the
code, the A file and the P file.

If not, how do we know what date will be in the file name. Is it today's
date, yesterday's date, some other date.

What does "Sheet B2:B6" mean?

Do you want to copy all the 7 cells in BP18:BU18 to a new row in the summary
sheet?

 

[Guest]

Sorry for the confusion. There are 2 files for each weekday M-F (1 "A" and 1
"P") and one file for Sat and Sun ("A" Only). I want to copy BP18:BU18 On
each "A" file in the directory to a new book starting in b2:b7 (typo not b6)

Example:
Myfile20050601A.xls
BP18:BU18 100 252 40 53 5000 250

Myfile20050602A.xls
BP18:BU18 500 235 400 5212 500 650

In the new book
b2:b7 100 252 40 53 5000 250
c2:c6 500 235 400 5212 500 650

Hope this helps
Thanks!

 

[Tom Ogilvy]

Not trying to be annoying, but in Excel

B2:B7 and C2:C7 would look like this:

b2:b7 c2:c6
100 500
252 235
40 400
53 5212
5000 500
250 650


Two columns, not two rows. Is that what you mean?

 

[Guest]

Youre not being annoying Im being dyslexic Got my columns and rows mixed
up
b2:g2
b3:g3
etc
Sorry!

 

[Tom Ogilvy]

Sub Summary()

Dim myCell As Range
Dim myBook as Workbook
Dim i as Long
Dim r as Range, r1 as Range

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Copy or move this workbook to the folder with
'the files that you want to summarize
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> ThisWorkbook.FullName Then
if instr(1,.foundfiles(i),"A.xls",vbTextCompare) then
Set myBook = Workbooks.Open(.FoundFiles(i))
myBook.Worksheets("sheet1").Select
set r = MyBook.Worksheets("Sheet1").Range("BP18:BU18")
set r1 = ThisWorkbook.Worksheets(1). _
Range("B65536").End(xlUp)
if r1.Row = 1 then set r1 = r1.offset(1,0)
if not isempty(r1) then set r1 = r1.offset(1,0)
r.copy destination:=r1
MyBook.Close SaveChanges:=False
End if ' Instr
End If ' not thisworkbook
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

ThisWorkbook.SaveAs Application.GetSaveAsFilename

End Sub

Untested, but this should be a start.

 

[Guest]

Thanks Tom
With a little tweaking I have it working. On my first run I found that a
daily file is missing. Is there a modification that I can make that would put
dd from myfileyyymmdd.xls in an adjacent cell?
Thanks again!

 

[Tom Ogilvy]

to get the two characters before the period

A technique would be:

assume sStr holds the fully qualified file name produced by fileSearch
iloc = Instr(1,sStr,".",vbtextcompare)
dd = mid(sStr,iloc-2,2)


to demonstrate from the immediate window:

sStr = "myfileyyymm29.xls"
iloc = Instr(1,sStr,".",vbtextcompare)
? iloc
14
dd = mid(sStr,iloc-2,2)
? dd
29

So you would just put the results of the variable in a cell.

Adjust to fit your code.

 

[Guest]

I understand what this is doing but Im not quite sure where/how to add it
Thanks