Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Macro
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Macro
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? -- Regards, Tom Ogilvy "Al" wrote in message ... 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Macro
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" wrote: 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? -- Regards, Tom Ogilvy "Al" wrote in message ... 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Macro
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? -- Regards, Tom Ogilvy "Al" wrote in message ... 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" wrote: 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? -- Regards, Tom Ogilvy "Al" wrote in message ... 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Macro
Youre not being annoying Im being dyslexic :-) Got my columns and rows mixed
up b2:g2 b3:g3 etc Sorry! "Tom Ogilvy" wrote: 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? -- Regards, Tom Ogilvy "Al" wrote in message ... 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" wrote: 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? -- Regards, Tom Ogilvy "Al" wrote in message ... 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Macro
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. -- Regards, Tom Ogilvy "Al" wrote in message ... Youre not being annoying Im being dyslexic :-) Got my columns and rows mixed up b2:g2 b3:g3 etc Sorry! "Tom Ogilvy" wrote: 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? -- Regards, Tom Ogilvy "Al" wrote in message ... 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" wrote: 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? -- Regards, Tom Ogilvy "Al" wrote in message ... 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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Macro
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" wrote: 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. -- Regards, Tom Ogilvy "Al" wrote in message ... Youre not being annoying Im being dyslexic :-) Got my columns and rows mixed up b2:g2 b3:g3 etc Sorry! "Tom Ogilvy" wrote: 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? -- Regards, Tom Ogilvy "Al" wrote in message ... 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" wrote: 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? -- Regards, Tom Ogilvy "Al" wrote in message ... 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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Macro
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. -- Regards, Tom Ogilvy "Al" wrote in message ... 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" wrote: 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. -- Regards, Tom Ogilvy "Al" wrote in message ... Youre not being annoying Im being dyslexic :-) Got my columns and rows mixed up b2:g2 b3:g3 etc Sorry! "Tom Ogilvy" wrote: 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? -- Regards, Tom Ogilvy "Al" wrote in message ... 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" wrote: 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? -- Regards, Tom Ogilvy "Al" wrote in message ... 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 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Macro
I understand what this is doing but Im not quite sure where/how to add it
Thanks "Tom Ogilvy" wrote: 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. -- Regards, Tom Ogilvy "Al" wrote in message ... 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" wrote: 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. -- Regards, Tom Ogilvy "Al" wrote in message ... Youre not being annoying Im being dyslexic :-) Got my columns and rows mixed up b2:g2 b3:g3 etc Sorry! "Tom Ogilvy" wrote: 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? -- Regards, Tom Ogilvy "Al" wrote in message ... 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" wrote: 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? -- Regards, Tom Ogilvy "Al" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copy workbook, don't copy macro | Excel Discussion (Misc queries) | |||
macro to copy | Excel Discussion (Misc queries) | |||
Copy a macro? | Excel Discussion (Misc queries) | |||
how to count/sum by function/macro to get the number of record to do copy/paste in macro | Excel Programming |