| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Only Copy Subtotals
hi,
how is your data layed out? Post 4 or 5 lines or enough to subtotal on. need something to key on. regards FSt1 "Stephen" wrote: Hi Folks, I have a sheet (Receives) that generates a dataset based on date parameters from a different sheet (Date Selection), then subtotals column "E" of the dataset at each change in column "A". That works like a charm. I need to be able to copy only the subtotal rows to a third sheet but I would like those copied rows to paste sequentially to row 1,2,3, etc. - does that make sence? Here is what I have so far... Sub Receives() ThisWorkbook.Worksheets("Receives").Select Range("A2").Select Selection.RemoveSubtotal Range("A1").Select Selection.QueryTable.Refresh BackgroundQuery:=False Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True ActiveSheet.Outline.ShowLevels RowLevels:=3 Columns("A:A").EntireColumn.AutoFit Range("A1").Select MsgBox "Operation completed successfully." End Sub I would like to have code prior to the Msgbox that would copy subtotals to sheet three. TIA! |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Only Copy Subtotals
I think I found my answer...
ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True Selection.Copy Sheets("Totals").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D:G").Delete Range("A1").Select ThisWorkbook.Worksheets("Receives").Select ActiveSheet.Outline.ShowLevels RowLevels:=3 Columns("A:A").EntireColumn.AutoFit Range("A1").Select MsgBox "Operation completed successfully." This seems to work fine. BUT I realized that column "B" is blank on these subtotal rows. Is there a way I can 'copy values to empty cells below filled cells in selection' before I copy them to the 'Totals' sheet?? I know this is a function that is included in ASAP Utilities, but I would like to incorporate this function into my macro. ??? "FSt1" wrote: hi, how is your data layed out? Post 4 or 5 lines or enough to subtotal on. need something to key on. regards FSt1 "Stephen" wrote: Hi Folks, I have a sheet (Receives) that generates a dataset based on date parameters from a different sheet (Date Selection), then subtotals column "E" of the dataset at each change in column "A". That works like a charm. I need to be able to copy only the subtotal rows to a third sheet but I would like those copied rows to paste sequentially to row 1,2,3, etc. - does that make sence? Here is what I have so far... Sub Receives() ThisWorkbook.Worksheets("Receives").Select Range("A2").Select Selection.RemoveSubtotal Range("A1").Select Selection.QueryTable.Refresh BackgroundQuery:=False Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True ActiveSheet.Outline.ShowLevels RowLevels:=3 Columns("A:A").EntireColumn.AutoFit Range("A1").Select MsgBox "Operation completed successfully." End Sub I would like to have code prior to the Msgbox that would copy subtotals to sheet three. TIA! |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Only Copy Subtotals
hi
i wrote a sub to copy the sub totals but it keys on my data. i was wanted to key it to your data. works pretty good. the if statement below keys on my data. you will need to change it to fit your data. post back if you have problems. Sub copysubtotals() Dim r As Range Dim rd As Range Set r = Range("B2") Do While Not IsEmpty(r) Set rd = r.Offset(1, 0) If r.Offset(0, -1).Value = "" Then Range(r, r.Offset(0, 3)).Copy Sheets("Sheet3").Range("A65000").End(xlUp). _ Offset(1, 0).PasteSpecial xlPasteValues End If Set r = rd Loop End Sub regards FSt1 "Stephen" wrote: I think I found my answer... ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True Selection.Copy Sheets("Totals").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D:G").Delete Range("A1").Select ThisWorkbook.Worksheets("Receives").Select ActiveSheet.Outline.ShowLevels RowLevels:=3 Columns("A:A").EntireColumn.AutoFit Range("A1").Select MsgBox "Operation completed successfully." This seems to work fine. BUT I realized that column "B" is blank on these subtotal rows. Is there a way I can 'copy values to empty cells below filled cells in selection' before I copy them to the 'Totals' sheet?? I know this is a function that is included in ASAP Utilities, but I would like to incorporate this function into my macro. ??? "FSt1" wrote: hi, how is your data layed out? Post 4 or 5 lines or enough to subtotal on. need something to key on. regards FSt1 "Stephen" wrote: Hi Folks, I have a sheet (Receives) that generates a dataset based on date parameters from a different sheet (Date Selection), then subtotals column "E" of the dataset at each change in column "A". That works like a charm. I need to be able to copy only the subtotal rows to a third sheet but I would like those copied rows to paste sequentially to row 1,2,3, etc. - does that make sence? Here is what I have so far... Sub Receives() ThisWorkbook.Worksheets("Receives").Select Range("A2").Select Selection.RemoveSubtotal Range("A1").Select Selection.QueryTable.Refresh BackgroundQuery:=False Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True ActiveSheet.Outline.ShowLevels RowLevels:=3 Columns("A:A").EntireColumn.AutoFit Range("A1").Select MsgBox "Operation completed successfully." End Sub I would like to have code prior to the Msgbox that would copy subtotals to sheet three. TIA! |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Only Copy Subtotals
I appreciate your code and may very very use it, but I've thought of a
different approach... If I subtotal on column "B", I can copy the correct values, clean the pasted data (delete useless columns and header row), and trim the last 6 characters to remove the word "Total" from my result set... Once I have my subtotals copied to my totals sheet and clean the columns... ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True Selection.Copy Sheets("Totals").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=True, Transpose:=False Range("F:I").Delete Range("C:D").Delete Range("A:A").Delete Range("1:1").Delete ....I need to figure out my last row in column "A", the trim the last 6 characters from each cell. Something like... Dim c As Range With Sheets("Totals") For Each c In .Range("A:A") c.Value = Right(c, 6) Next End With ??? "FSt1" wrote: hi i wrote a sub to copy the sub totals but it keys on my data. i was wanted to key it to your data. works pretty good. the if statement below keys on my data. you will need to change it to fit your data. post back if you have problems. Sub copysubtotals() Dim r As Range Dim rd As Range Set r = Range("B2") Do While Not IsEmpty(r) Set rd = r.Offset(1, 0) If r.Offset(0, -1).Value = "" Then Range(r, r.Offset(0, 3)).Copy Sheets("Sheet3").Range("A65000").End(xlUp). _ Offset(1, 0).PasteSpecial xlPasteValues End If Set r = rd Loop End Sub regards FSt1 "Stephen" wrote: I think I found my answer... ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True Selection.Copy Sheets("Totals").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D:G").Delete Range("A1").Select ThisWorkbook.Worksheets("Receives").Select ActiveSheet.Outline.ShowLevels RowLevels:=3 Columns("A:A").EntireColumn.AutoFit Range("A1").Select MsgBox "Operation completed successfully." This seems to work fine. BUT I realized that column "B" is blank on these subtotal rows. Is there a way I can 'copy values to empty cells below filled cells in selection' before I copy them to the 'Totals' sheet?? I know this is a function that is included in ASAP Utilities, but I would like to incorporate this function into my macro. ??? "FSt1" wrote: hi, how is your data layed out? Post 4 or 5 lines or enough to subtotal on. need something to key on. regards FSt1 "Stephen" wrote: Hi Folks, I have a sheet (Receives) that generates a dataset based on date parameters from a different sheet (Date Selection), then subtotals column "E" of the dataset at each change in column "A". That works like a charm. I need to be able to copy only the subtotal rows to a third sheet but I would like those copied rows to paste sequentially to row 1,2,3, etc. - does that make sence? Here is what I have so far... Sub Receives() ThisWorkbook.Worksheets("Receives").Select Range("A2").Select Selection.RemoveSubtotal Range("A1").Select Selection.QueryTable.Refresh BackgroundQuery:=False Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True ActiveSheet.Outline.ShowLevels RowLevels:=3 Columns("A:A").EntireColumn.AutoFit Range("A1").Select MsgBox "Operation completed successfully." End Sub I would like to have code prior to the Msgbox that would copy subtotals to sheet three. TIA! |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Only Copy Subtotals
hi
not sure but the trim function seems like it would work but you deleted column A before you got to it. or did i miss something? test it. use it if it works. Regards FSt1 "Stephen" wrote: I appreciate your code and may very very use it, but I've thought of a different approach... If I subtotal on column "B", I can copy the correct values, clean the pasted data (delete useless columns and header row), and trim the last 6 characters to remove the word "Total" from my result set... Once I have my subtotals copied to my totals sheet and clean the columns... ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True Selection.Copy Sheets("Totals").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=True, Transpose:=False Range("F:I").Delete Range("C:D").Delete Range("A:A").Delete Range("1:1").Delete ...I need to figure out my last row in column "A", the trim the last 6 characters from each cell. Something like... Dim c As Range With Sheets("Totals") For Each c In .Range("A:A") c.Value = Right(c, 6) Next End With ??? "FSt1" wrote: hi i wrote a sub to copy the sub totals but it keys on my data. i was wanted to key it to your data. works pretty good. the if statement below keys on my data. you will need to change it to fit your data. post back if you have problems. Sub copysubtotals() Dim r As Range Dim rd As Range Set r = Range("B2") Do While Not IsEmpty(r) Set rd = r.Offset(1, 0) If r.Offset(0, -1).Value = "" Then Range(r, r.Offset(0, 3)).Copy Sheets("Sheet3").Range("A65000").End(xlUp). _ Offset(1, 0).PasteSpecial xlPasteValues End If Set r = rd Loop End Sub regards FSt1 "Stephen" wrote: I think I found my answer... ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True Selection.Copy Sheets("Totals").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D:G").Delete Range("A1").Select ThisWorkbook.Worksheets("Receives").Select ActiveSheet.Outline.ShowLevels RowLevels:=3 Columns("A:A").EntireColumn.AutoFit Range("A1").Select MsgBox "Operation completed successfully." This seems to work fine. BUT I realized that column "B" is blank on these subtotal rows. Is there a way I can 'copy values to empty cells below filled cells in selection' before I copy them to the 'Totals' sheet?? I know this is a function that is included in ASAP Utilities, but I would like to incorporate this function into my macro. ??? "FSt1" wrote: hi, how is your data layed out? Post 4 or 5 lines or enough to subtotal on. need something to key on. regards FSt1 "Stephen" wrote: Hi Folks, I have a sheet (Receives) that generates a dataset based on date parameters from a different sheet (Date Selection), then subtotals column "E" of the dataset at each change in column "A". That works like a charm. I need to be able to copy only the subtotal rows to a third sheet but I would like those copied rows to paste sequentially to row 1,2,3, etc. - does that make sence? Here is what I have so far... Sub Receives() ThisWorkbook.Worksheets("Receives").Select Range("A2").Select Selection.RemoveSubtotal Range("A1").Select Selection.QueryTable.Refresh BackgroundQuery:=False Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True ActiveSheet.Outline.ShowLevels RowLevels:=3 Columns("A:A").EntireColumn.AutoFit Range("A1").Select MsgBox "Operation completed successfully." End Sub I would like to have code prior to the Msgbox that would copy subtotals to sheet three. TIA! |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Only Copy Subtotals
Trim results in deleting everything except the last six characters.
when I delete my column "A", my column "B" becomes my new column "A" which is where I need to remove the last six characters from each used cell. LEN?? "FSt1" wrote: hi not sure but the trim function seems like it would work but you deleted column A before you got to it. or did i miss something? test it. use it if it works. Regards FSt1 "Stephen" wrote: I appreciate your code and may very very use it, but I've thought of a different approach... If I subtotal on column "B", I can copy the correct values, clean the pasted data (delete useless columns and header row), and trim the last 6 characters to remove the word "Total" from my result set... Once I have my subtotals copied to my totals sheet and clean the columns... ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True Selection.Copy Sheets("Totals").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=True, Transpose:=False Range("F:I").Delete Range("C:D").Delete Range("A:A").Delete Range("1:1").Delete ...I need to figure out my last row in column "A", the trim the last 6 characters from each cell. Something like... Dim c As Range With Sheets("Totals") For Each c In .Range("A:A") c.Value = Right(c, 6) Next End With ??? "FSt1" wrote: hi i wrote a sub to copy the sub totals but it keys on my data. i was wanted to key it to your data. works pretty good. the if statement below keys on my data. you will need to change it to fit your data. post back if you have problems. Sub copysubtotals() Dim r As Range Dim rd As Range Set r = Range("B2") Do While Not IsEmpty(r) Set rd = r.Offset(1, 0) If r.Offset(0, -1).Value = "" Then Range(r, r.Offset(0, 3)).Copy Sheets("Sheet3").Range("A65000").End(xlUp). _ Offset(1, 0).PasteSpecial xlPasteValues End If Set r = rd Loop End Sub regards FSt1 "Stephen" wrote: I think I found my answer... ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True Selection.Copy Sheets("Totals").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D:G").Delete Range("A1").Select ThisWorkbook.Worksheets("Receives").Select ActiveSheet.Outline.ShowLevels RowLevels:=3 Columns("A:A").EntireColumn.AutoFit Range("A1").Select MsgBox "Operation completed successfully." This seems to work fine. BUT I realized that column "B" is blank on these subtotal rows. Is there a way I can 'copy values to empty cells below filled cells in selection' before I copy them to the 'Totals' sheet?? I know this is a function that is included in ASAP Utilities, but I would like to incorporate this function into my macro. ??? "FSt1" wrote: hi, how is your data layed out? Post 4 or 5 lines or enough to subtotal on. need something to key on. regards FSt1 "Stephen" wrote: Hi Folks, I have a sheet (Receives) that generates a dataset based on date parameters from a different sheet (Date Selection), then subtotals column "E" of the dataset at each change in column "A". That works like a charm. I need to be able to copy only the subtotal rows to a third sheet but I would like those copied rows to paste sequentially to row 1,2,3, etc. - does that make sence? Here is what I have so far... Sub Receives() ThisWorkbook.Worksheets("Receives").Select Range("A2").Select Selection.RemoveSubtotal Range("A1").Select Selection.QueryTable.Refresh BackgroundQuery:=False Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True ActiveSheet.Outline.ShowLevels RowLevels:=3 Columns("A:A").EntireColumn.AutoFit Range("A1").Select MsgBox "Operation completed successfully." End Sub I would like to have code prior to the Msgbox that would copy subtotals to sheet three. TIA! |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Only Copy Subtotals
hi
now that i think about it. the trim function just trims leading and trailing spaces. len.... that will just give the the length of characters in a string. last 6 characters....right(A1,6) regards FSt1 "Stephen" wrote: Trim results in deleting everything except the last six characters. when I delete my column "A", my column "B" becomes my new column "A" which is where I need to remove the last six characters from each used cell. LEN?? "FSt1" wrote: hi not sure but the trim function seems like it would work but you deleted column A before you got to it. or did i miss something? test it. use it if it works. Regards FSt1 "Stephen" wrote: I appreciate your code and may very very use it, but I've thought of a different approach... If I subtotal on column "B", I can copy the correct values, clean the pasted data (delete useless columns and header row), and trim the last 6 characters to remove the word "Total" from my result set... Once I have my subtotals copied to my totals sheet and clean the columns... ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True Selection.Copy Sheets("Totals").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=True, Transpose:=False Range("F:I").Delete Range("C:D").Delete Range("A:A").Delete Range("1:1").Delete ...I need to figure out my last row in column "A", the trim the last 6 characters from each cell. Something like... Dim c As Range With Sheets("Totals") For Each c In .Range("A:A") c.Value = Right(c, 6) Next End With ??? "FSt1" wrote: hi i wrote a sub to copy the sub totals but it keys on my data. i was wanted to key it to your data. works pretty good. the if statement below keys on my data. you will need to change it to fit your data. post back if you have problems. Sub copysubtotals() Dim r As Range Dim rd As Range Set r = Range("B2") Do While Not IsEmpty(r) Set rd = r.Offset(1, 0) If r.Offset(0, -1).Value = "" Then Range(r, r.Offset(0, 3)).Copy Sheets("Sheet3").Range("A65000").End(xlUp). _ Offset(1, 0).PasteSpecial xlPasteValues End If Set r = rd Loop End Sub regards FSt1 "Stephen" wrote: I think I found my answer... ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True Selection.Copy Sheets("Totals").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D:G").Delete Range("A1").Select ThisWorkbook.Worksheets("Receives").Select ActiveSheet.Outline.ShowLevels RowLevels:=3 Columns("A:A").EntireColumn.AutoFit Range("A1").Select MsgBox "Operation completed successfully." This seems to work fine. BUT I realized that column "B" is blank on these subtotal rows. Is there a way I can 'copy values to empty cells below filled cells in selection' before I copy them to the 'Totals' sheet?? I know this is a function that is included in ASAP Utilities, but I would like to incorporate this function into my macro. ??? "FSt1" wrote: hi, how is your data layed out? Post 4 or 5 lines or enough to subtotal on. need something to key on. regards FSt1 "Stephen" wrote: Hi Folks, I have a sheet (Receives) that generates a dataset based on date parameters from a different sheet (Date Selection), then subtotals column "E" of the dataset at each change in column "A". That works like a charm. I need to be able to copy only the subtotal rows to a third sheet but I would like those copied rows to paste sequentially to row 1,2,3, etc. - does that make sence? Here is what I have so far... Sub Receives() ThisWorkbook.Worksheets("Receives").Select Range("A2").Select Selection.RemoveSubtotal Range("A1").Select Selection.QueryTable.Refresh BackgroundQuery:=False Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True ActiveSheet.Outline.ShowLevels RowLevels:=3 Columns("A:A").EntireColumn.AutoFit Range("A1").Select MsgBox "Operation completed successfully." End Sub I would like to have code prior to the Msgbox that would copy subtotals to sheet three. TIA! |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Only Copy Subtotals
What about:
Columns("A:A").Select Selection.Replace What:=" Total", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False "FSt1" wrote: hi now that i think about it. the trim function just trims leading and trailing spaces. len.... that will just give the the length of characters in a string. last 6 characters....right(A1,6) regards FSt1 "Stephen" wrote: Trim results in deleting everything except the last six characters. when I delete my column "A", my column "B" becomes my new column "A" which is where I need to remove the last six characters from each used cell. LEN?? "FSt1" wrote: hi not sure but the trim function seems like it would work but you deleted column A before you got to it. or did i miss something? test it. use it if it works. Regards FSt1 "Stephen" wrote: I appreciate your code and may very very use it, but I've thought of a different approach... If I subtotal on column "B", I can copy the correct values, clean the pasted data (delete useless columns and header row), and trim the last 6 characters to remove the word "Total" from my result set... Once I have my subtotals copied to my totals sheet and clean the columns... ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True Selection.Copy Sheets("Totals").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=True, Transpose:=False Range("F:I").Delete Range("C:D").Delete Range("A:A").Delete Range("1:1").Delete ...I need to figure out my last row in column "A", the trim the last 6 characters from each cell. Something like... Dim c As Range With Sheets("Totals") For Each c In .Range("A:A") c.Value = Right(c, 6) Next End With ??? "FSt1" wrote: hi i wrote a sub to copy the sub totals but it keys on my data. i was wanted to key it to your data. works pretty good. the if statement below keys on my data. you will need to change it to fit your data. post back if you have problems. Sub copysubtotals() Dim r As Range Dim rd As Range Set r = Range("B2") Do While Not IsEmpty(r) Set rd = r.Offset(1, 0) If r.Offset(0, -1).Value = "" Then Range(r, r.Offset(0, 3)).Copy Sheets("Sheet3").Range("A65000").End(xlUp). _ Offset(1, 0).PasteSpecial xlPasteValues End If Set r = rd Loop End Sub regards FSt1 "Stephen" wrote: I think I found my answer... ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True Selection.Copy Sheets("Totals").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D:G").Delete Range("A1").Select ThisWorkbook.Worksheets("Receives").Select ActiveSheet.Outline.ShowLevels RowLevels:=3 Columns("A:A").EntireColumn.AutoFit Range("A1").Select MsgBox "Operation completed successfully." This seems to work fine. BUT I realized that column "B" is blank on these subtotal rows. Is there a way I can 'copy values to empty cells below filled cells in selection' before I copy them to the 'Totals' sheet?? I know this is a function that is included in ASAP Utilities, but I would like to incorporate this function into my macro. ??? "FSt1" wrote: hi, how is your data layed out? Post 4 or 5 lines or enough to subtotal on. need something to key on. regards FSt1 "Stephen" wrote: Hi Folks, I have a sheet (Receives) that generates a dataset based on date parameters from a different sheet (Date Selection), then subtotals column "E" of the dataset at each change in column "A". That works like a charm. I need to be able to copy only the subtotal rows to a third sheet but I would like those copied rows to paste sequentially to row 1,2,3, etc. - does that make sence? Here is what I have so far... Sub Receives() ThisWorkbook.Worksheets("Receives").Select Range("A2").Select Selection.RemoveSubtotal Range("A1").Select Selection.QueryTable.Refresh BackgroundQuery:=False Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True ActiveSheet.Outline.ShowLevels RowLevels:=2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Font.Bold = False Selection.Font.Bold = True ActiveSheet.Outline.ShowLevels RowLevels:=3 Columns("A:A").EntireColumn.AutoFit Range("A1").Select MsgBox "Operation completed successfully." End Sub I would like to have code prior to the Msgbox that would copy subtotals to sheet three. TIA! |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Copy subtotals | Excel Discussion (Misc queries) | |||
| copy just subtotals ? | Excel Programming | |||
| Copy subtotals | Excel Discussion (Misc queries) | |||
| How do I copy an outline w/ subtotals & paste just the subtotals | Excel Discussion (Misc queries) | |||
| When using subtotals, how do I copy and paste only the subtotals . | Excel Worksheet Functions | |||
Linear Mode
