Home |
Search |
Today's Posts |
#1
|
|||
|
|||
Copying multiple sheets from one book 2 another and undertake spec
Copying multiple sheets from one book 2 another and undertake special editing.
Apologies as the following is long winded. I have a workbook that has 12 sheets (i.e. 1 for each month of the Year). Each sheet contains the following: - Header row; Customer name; date contacted and work location (and other information). One can have multiple rows for each customer as they can contact us many times a day for work to be undertaken at different locations. On a monthly basis we have to undertake a charging process for customers who have used our services for the last month. At the moment we all copy the information from each monthly sheet to another workbook and sort it on Customer name. Having sorted the information, someone manually creates a worksheet for each customer using Cut + Paste and then creates an invoice. Things have now changed and we have to charge on a quarterly basis. Is there any way that a front-end screen can be written in which one specifies sheet names that need to be charged for and a destination sheet name. Once the sheet names have been entered, we would like the appropriate sheets (may be selected columns) to be copied to an existing workbook (using Paste special and Values) with the name specified as destination. Obviously once the sheets have been copied, there will be three headers, I would ideally like to search the destination sheet and delete the extra 2 headers automatically before it is sorted in the format that is required. Having sorted the sheet, we would like to create individual sheets for all the different customers that exist on the master sheet and have all rows for that customer copied into their named sheet. Any help offered would be most appreciated. |
#2
|
|||
|
|||
What you're asking for is doable.
But how about a slightly different approach? Put all your data on one worksheet. Add a column that corresponds to date. By putting all the data in one spot, it makes updating easier (or at least more consistent--like when you add a column, you don't have to add it to several worksheets. Then you could use a macro that filters that worksheet (by date and by customer) and creates the separate worksheets that way. Debra Dalgleish has some code that comes kind of close to doing this -- but it's based on only one column. You could tweak that code or you could insert a new column that combines dates/customers -- so you can treat it as one field. http://www.contextures.com/excelfiles.html Create New Sheets from Filtered List -- uses an Advanced Filter to create separate sheet of orders for each sales rep visible in a filtered list; macro automates the filter. AdvFilterRepFiltered.xls 35 kb Update Sheets from Master -- uses an Advanced Filter to send data from Master sheet to individual worksheets -- replaces old data with current. AdvFilterCity.xls 55 kb ====== But this may get you started with the original question. Select/group your sheets (click on the first tab, ctrl-click on the next two tabs.) Option Explicit Sub testme01() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Set mySelectedSheets = ActiveWindow.SelectedSheets If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(1).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell End With With newWks Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next Wks 'delete columns you don't want. End Sub Remember to ungroup the sheets when you're done. Anything you do to one of those sheets, you do to all 3! So you can really hose up a workbook really fast! And after you have the 3 worksheets combined, you could still use code from Debra's site to break them apart per customer. Pank Mehta wrote: Copying multiple sheets from one book 2 another and undertake special editing. Apologies as the following is long winded. I have a workbook that has 12 sheets (i.e. 1 for each month of the Year). Each sheet contains the following: - Header row; Customer name; date contacted and work location (and other information). One can have multiple rows for each customer as they can contact us many times a day for work to be undertaken at different locations. On a monthly basis we have to undertake a charging process for customers who have used our services for the last month. At the moment we all copy the information from each monthly sheet to another workbook and sort it on Customer name. Having sorted the information, someone manually creates a worksheet for each customer using Cut + Paste and then creates an invoice. Things have now changed and we have to charge on a quarterly basis. Is there any way that a front-end screen can be written in which one specifies sheet names that need to be charged for and a destination sheet name. Once the sheet names have been entered, we would like the appropriate sheets (may be selected columns) to be copied to an existing workbook (using Paste special and Values) with the name specified as destination. Obviously once the sheets have been copied, there will be three headers, I would ideally like to search the destination sheet and delete the extra 2 headers automatically before it is sorted in the format that is required. Having sorted the sheet, we would like to create individual sheets for all the different customers that exist on the master sheet and have all rows for that customer copied into their named sheet. Any help offered would be most appreciated. -- Dave Peterson |
#3
|
|||
|
|||
Dave,
Many thanks for your valuable comments and suggestion. I will talk to the people regarding your suggestion and see what their view are and will also look at the site you mention. Once again many thanks. "Pank Mehta" wrote: Copying multiple sheets from one book 2 another and undertake special editing. Apologies as the following is long winded. I have a workbook that has 12 sheets (i.e. 1 for each month of the Year). Each sheet contains the following: - Header row; Customer name; date contacted and work location (and other information). One can have multiple rows for each customer as they can contact us many times a day for work to be undertaken at different locations. On a monthly basis we have to undertake a charging process for customers who have used our services for the last month. At the moment we all copy the information from each monthly sheet to another workbook and sort it on Customer name. Having sorted the information, someone manually creates a worksheet for each customer using Cut + Paste and then creates an invoice. Things have now changed and we have to charge on a quarterly basis. Is there any way that a front-end screen can be written in which one specifies sheet names that need to be charged for and a destination sheet name. Once the sheet names have been entered, we would like the appropriate sheets (may be selected columns) to be copied to an existing workbook (using Paste special and Values) with the name specified as destination. Obviously once the sheets have been copied, there will be three headers, I would ideally like to search the destination sheet and delete the extra 2 headers automatically before it is sorted in the format that is required. Having sorted the sheet, we would like to create individual sheets for all the different customers that exist on the master sheet and have all rows for that customer copied into their named sheet. Any help offered would be most appreciated. |
#4
|
|||
|
|||
Dave,
I have finally, got round to testing the code that you were kind enough to provide. Having run the code I get the message "Run Time error 1004, You cannot use this command on a protected sheet. To unprotect ....". When I click on the debug statement it points to the line with the following code:- ..Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell I inserted "ActiveWorkbook.Unprotect" prior to the above statement and also prior to the first IF statement, but unfortunately this does not resolve the problem. It has managed to copy the first sheet, inserted the data onto a new sheet and then produces the above message. Lastly, on the copy how do I change it so that it does a special and copies values as opposed to formulas. Help much appreciated. "Pank Mehta" wrote: Copying multiple sheets from one book 2 another and undertake special editing. Apologies as the following is long winded. I have a workbook that has 12 sheets (i.e. 1 for each month of the Year). Each sheet contains the following: - Header row; Customer name; date contacted and work location (and other information). One can have multiple rows for each customer as they can contact us many times a day for work to be undertaken at different locations. On a monthly basis we have to undertake a charging process for customers who have used our services for the last month. At the moment we all copy the information from each monthly sheet to another workbook and sort it on Customer name. Having sorted the information, someone manually creates a worksheet for each customer using Cut + Paste and then creates an invoice. Things have now changed and we have to charge on a quarterly basis. Is there any way that a front-end screen can be written in which one specifies sheet names that need to be charged for and a destination sheet name. Once the sheet names have been entered, we would like the appropriate sheets (may be selected columns) to be copied to an existing workbook (using Paste special and Values) with the name specified as destination. Obviously once the sheets have been copied, there will be three headers, I would ideally like to search the destination sheet and delete the extra 2 headers automatically before it is sorted in the format that is required. Having sorted the sheet, we would like to create individual sheets for all the different customers that exist on the master sheet and have all rows for that customer copied into their named sheet. Any help offered would be most appreciated. |
#5
|
|||
|
|||
First, by directing this to me, you do limit the number of response from
others. And that will hurt you in the long run--lots of people could have helped. Second, you have to unprotect the worksheet. activesheet.unprotect password:="yourpasswordhere" (I don't recall if this was for the activesheet or some other sheet, though.) But from the snippet of code you posted, it should fit in right before this line: .unprotect password:="yourpasswordhere" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell .protect password:="yourpasswordhere" And if you only want the values, you can either copy|paste special values or just assign the value. dim myRngToCopy as range '...some more code with worksheets("someworksheet") .unprotect password:="yourpasswordhere" set myrngtocopy = .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)) destcell.resize(myrngtocopy.rows.count,myrngtocopy .columns.count).value _ = myrngtocopy.value .protect password:="yourpasswordhere" end with ====== or equivalently: with worksheets("someworksheet") .unprotect password:="yourpasswordhere" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).copy destcell.pastespecial paste:=xlpastevalues .protect password:="yourpasswordhere" end with I like the assignment of values myself. Ann wrote: Dave, I have finally, got round to testing the code that you were kind enough to provide. Having run the code I get the message "Run Time error 1004, You cannot use this command on a protected sheet. To unprotect ....". When I click on the debug statement it points to the line with the following code:- .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell I inserted "ActiveWorkbook.Unprotect" prior to the above statement and also prior to the first IF statement, but unfortunately this does not resolve the problem. It has managed to copy the first sheet, inserted the data onto a new sheet and then produces the above message. Lastly, on the copy how do I change it so that it does a special and copies values as opposed to formulas. Help much appreciated. "Pank Mehta" wrote: Copying multiple sheets from one book 2 another and undertake special editing. Apologies as the following is long winded. I have a workbook that has 12 sheets (i.e. 1 for each month of the Year). Each sheet contains the following: - Header row; Customer name; date contacted and work location (and other information). One can have multiple rows for each customer as they can contact us many times a day for work to be undertaken at different locations. On a monthly basis we have to undertake a charging process for customers who have used our services for the last month. At the moment we all copy the information from each monthly sheet to another workbook and sort it on Customer name. Having sorted the information, someone manually creates a worksheet for each customer using Cut + Paste and then creates an invoice. Things have now changed and we have to charge on a quarterly basis. Is there any way that a front-end screen can be written in which one specifies sheet names that need to be charged for and a destination sheet name. Once the sheet names have been entered, we would like the appropriate sheets (may be selected columns) to be copied to an existing workbook (using Paste special and Values) with the name specified as destination. Obviously once the sheets have been copied, there will be three headers, I would ideally like to search the destination sheet and delete the extra 2 headers automatically before it is sorted in the format that is required. Having sorted the sheet, we would like to create individual sheets for all the different customers that exist on the master sheet and have all rows for that customer copied into their named sheet. Any help offered would be most appreciated. -- Dave Peterson |
#6
|
|||
|
|||
Dave,
Firstly, many thanks for your help. However, I am now encountering the following problem. "Compile Error : Expected End With" and the only End With in the code is highlighted in yellow when I select debug. Detailed below is the code that I have:- Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False For Each Wks In mySelectedSheets ActiveWorkbook.Unprotect With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(1).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If With Worksheets("sheet1") .Unprotect password:="" Set myRngToCopy = .Range("a2", ..Cells.SpecialCells(xlCellTypeLastCell)) DestCell.Resize(myRngToCopy.Rows.Count, myRngToCopy.Columns.Count).Value _ = myRngToCopy.Value .Protect password:="" End With With newWks Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) 'Next Wks 'delete columns you don't want. End With End Sub "Dave Peterson" wrote: What you're asking for is doable. But how about a slightly different approach? Put all your data on one worksheet. Add a column that corresponds to date. By putting all the data in one spot, it makes updating easier (or at least more consistent--like when you add a column, you don't have to add it to several worksheets. Then you could use a macro that filters that worksheet (by date and by customer) and creates the separate worksheets that way. Debra Dalgleish has some code that comes kind of close to doing this -- but it's based on only one column. You could tweak that code or you could insert a new column that combines dates/customers -- so you can treat it as one field. http://www.contextures.com/excelfiles.html Create New Sheets from Filtered List -- uses an Advanced Filter to create separate sheet of orders for each sales rep visible in a filtered list; macro automates the filter. AdvFilterRepFiltered.xls 35 kb Update Sheets from Master -- uses an Advanced Filter to send data from Master sheet to individual worksheets -- replaces old data with current. AdvFilterCity.xls 55 kb ====== But this may get you started with the original question. Select/group your sheets (click on the first tab, ctrl-click on the next two tabs.) Option Explicit Sub testme01() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Set mySelectedSheets = ActiveWindow.SelectedSheets If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(1).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell End With With newWks Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next Wks 'delete columns you don't want. End Sub Remember to ungroup the sheets when you're done. Anything you do to one of those sheets, you do to all 3! So you can really hose up a workbook really fast! And after you have the 3 worksheets combined, you could still use code from Debra's site to break them apart per customer. Pank Mehta wrote: Copying multiple sheets from one book 2 another and undertake special editing. Apologies as the following is long winded. I have a workbook that has 12 sheets (i.e. 1 for each month of the Year). Each sheet contains the following: - Header row; Customer name; date contacted and work location (and other information). One can have multiple rows for each customer as they can contact us many times a day for work to be undertaken at different locations. On a monthly basis we have to undertake a charging process for customers who have used our services for the last month. At the moment we all copy the information from each monthly sheet to another workbook and sort it on Customer name. Having sorted the information, someone manually creates a worksheet for each customer using Cut + Paste and then creates an invoice. Things have now changed and we have to charge on a quarterly basis. Is there any way that a front-end screen can be written in which one specifies sheet names that need to be charged for and a destination sheet name. Once the sheet names have been entered, we would like the appropriate sheets (may be selected columns) to be copied to an existing workbook (using Paste special and Values) with the name specified as destination. Obviously once the sheets have been copied, there will be three headers, I would ideally like to search the destination sheet and delete the extra 2 headers automatically before it is sorted in the format that is required. Having sorted the sheet, we would like to create individual sheets for all the different customers that exist on the master sheet and have all rows for that customer copied into their named sheet. Any help offered would be most appreciated. -- Dave Peterson |
#7
|
|||
|
|||
I'm not sure if this works, but it compiled for me:
Option Explicit Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False ActiveWorkbook.Unprotect For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(1).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If With Worksheets("sheet1") .Unprotect Password:="" Set myRngToCopy = .Range("a2", _ .Cells.SpecialCells(xlCellTypeLastCell)) DestCell.Resize(myRngToCopy.Rows.Count, _ myRngToCopy.Columns.Count).Value _ = myRngToCopy.Value .Protect Password:="" End With Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next Wks End Sub I added an End With and moved the workbook protection out of the loop. You may want to turn that workbook protection back on when your macro is done. Ann wrote: Dave, Firstly, many thanks for your help. However, I am now encountering the following problem. "Compile Error : Expected End With" and the only End With in the code is highlighted in yellow when I select debug. Detailed below is the code that I have:- Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False For Each Wks In mySelectedSheets ActiveWorkbook.Unprotect With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(1).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If With Worksheets("sheet1") .Unprotect password:="" Set myRngToCopy = .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)) DestCell.Resize(myRngToCopy.Rows.Count, myRngToCopy.Columns.Count).Value _ = myRngToCopy.Value .Protect password:="" End With With newWks Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) 'Next Wks 'delete columns you don't want. End With End Sub "Dave Peterson" wrote: What you're asking for is doable. But how about a slightly different approach? Put all your data on one worksheet. Add a column that corresponds to date. By putting all the data in one spot, it makes updating easier (or at least more consistent--like when you add a column, you don't have to add it to several worksheets. Then you could use a macro that filters that worksheet (by date and by customer) and creates the separate worksheets that way. Debra Dalgleish has some code that comes kind of close to doing this -- but it's based on only one column. You could tweak that code or you could insert a new column that combines dates/customers -- so you can treat it as one field. http://www.contextures.com/excelfiles.html Create New Sheets from Filtered List -- uses an Advanced Filter to create separate sheet of orders for each sales rep visible in a filtered list; macro automates the filter. AdvFilterRepFiltered.xls 35 kb Update Sheets from Master -- uses an Advanced Filter to send data from Master sheet to individual worksheets -- replaces old data with current. AdvFilterCity.xls 55 kb ====== But this may get you started with the original question. Select/group your sheets (click on the first tab, ctrl-click on the next two tabs.) Option Explicit Sub testme01() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Set mySelectedSheets = ActiveWindow.SelectedSheets If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(1).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell End With With newWks Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next Wks 'delete columns you don't want. End Sub Remember to ungroup the sheets when you're done. Anything you do to one of those sheets, you do to all 3! So you can really hose up a workbook really fast! And after you have the 3 worksheets combined, you could still use code from Debra's site to break them apart per customer. Pank Mehta wrote: Copying multiple sheets from one book 2 another and undertake special editing. Apologies as the following is long winded. I have a workbook that has 12 sheets (i.e. 1 for each month of the Year). Each sheet contains the following: - Header row; Customer name; date contacted and work location (and other information). One can have multiple rows for each customer as they can contact us many times a day for work to be undertaken at different locations. On a monthly basis we have to undertake a charging process for customers who have used our services for the last month. At the moment we all copy the information from each monthly sheet to another workbook and sort it on Customer name. Having sorted the information, someone manually creates a worksheet for each customer using Cut + Paste and then creates an invoice. Things have now changed and we have to charge on a quarterly basis. Is there any way that a front-end screen can be written in which one specifies sheet names that need to be charged for and a destination sheet name. Once the sheet names have been entered, we would like the appropriate sheets (may be selected columns) to be copied to an existing workbook (using Paste special and Values) with the name specified as destination. Obviously once the sheets have been copied, there will be three headers, I would ideally like to search the destination sheet and delete the extra 2 headers automatically before it is sorted in the format that is required. Having sorted the sheet, we would like to create individual sheets for all the different customers that exist on the master sheet and have all rows for that customer copied into their named sheet. Any help offered would be most appreciated. -- Dave Peterson -- Dave Peterson |
#8
|
|||
|
|||
Dave,
Sorry to be a pain in A**E. The code I have is:- Option Explicit Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False ActiveWorkbook.Unprotect For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(2).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If With Worksheets("someworksheet") .Unprotect password:="" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy DestCell.PasteSpecial Paste:=xlPasteValues .Protect password:="" End With Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next Wks End Sub Unfortunately, I get the message "subscript out of range". Please help. Woulf it help if we communicate directly via emails?. Once we (well you) have cracked it I would still post the full result to the newsgroup just in case it is usefull to other people? "Dave Peterson" wrote: First, by directing this to me, you do limit the number of response from others. And that will hurt you in the long run--lots of people could have helped. Second, you have to unprotect the worksheet. activesheet.unprotect password:="yourpasswordhere" (I don't recall if this was for the activesheet or some other sheet, though.) But from the snippet of code you posted, it should fit in right before this line: .unprotect password:="yourpasswordhere" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell .protect password:="yourpasswordhere" And if you only want the values, you can either copy|paste special values or just assign the value. dim myRngToCopy as range '...some more code with worksheets("someworksheet") .unprotect password:="yourpasswordhere" set myrngtocopy = .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)) destcell.resize(myrngtocopy.rows.count,myrngtocopy .columns.count).value _ = myrngtocopy.value .protect password:="yourpasswordhere" end with ====== or equivalently: with worksheets("someworksheet") .unprotect password:="yourpasswordhere" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).copy destcell.pastespecial paste:=xlpastevalues .protect password:="yourpasswordhere" end with I like the assignment of values myself. Ann wrote: Dave, I have finally, got round to testing the code that you were kind enough to provide. Having run the code I get the message "Run Time error 1004, You cannot use this command on a protected sheet. To unprotect ....". When I click on the debug statement it points to the line with the following code:- .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell I inserted "ActiveWorkbook.Unprotect" prior to the above statement and also prior to the first IF statement, but unfortunately this does not resolve the problem. It has managed to copy the first sheet, inserted the data onto a new sheet and then produces the above message. Lastly, on the copy how do I change it so that it does a special and copies values as opposed to formulas. Help much appreciated. "Pank Mehta" wrote: Copying multiple sheets from one book 2 another and undertake special editing. Apologies as the following is long winded. I have a workbook that has 12 sheets (i.e. 1 for each month of the Year). Each sheet contains the following: - Header row; Customer name; date contacted and work location (and other information). One can have multiple rows for each customer as they can contact us many times a day for work to be undertaken at different locations. On a monthly basis we have to undertake a charging process for customers who have used our services for the last month. At the moment we all copy the information from each monthly sheet to another workbook and sort it on Customer name. Having sorted the information, someone manually creates a worksheet for each customer using Cut + Paste and then creates an invoice. Things have now changed and we have to charge on a quarterly basis. Is there any way that a front-end screen can be written in which one specifies sheet names that need to be charged for and a destination sheet name. Once the sheet names have been entered, we would like the appropriate sheets (may be selected columns) to be copied to an existing workbook (using Paste special and Values) with the name specified as destination. Obviously once the sheets have been copied, there will be three headers, I would ideally like to search the destination sheet and delete the extra 2 headers automatically before it is sorted in the format that is required. Having sorted the sheet, we would like to create individual sheets for all the different customers that exist on the master sheet and have all rows for that customer copied into their named sheet. Any help offered would be most appreciated. -- Dave Peterson |
#9
|
|||
|
|||
That snippet could have been editted when you merged it with the existing code:
Option Explicit Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False ActiveWorkbook.Unprotect For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(2).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If .Unprotect password:="" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy DestCell.PasteSpecial Paste:=xlPasteValues .Protect password:="" Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next Wks End Sub I deleted the "With Worksheets("someworksheet")" and associated "end with" statements. Pank Mehta wrote: Dave, Sorry to be a pain in A**E. The code I have is:- Option Explicit Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False ActiveWorkbook.Unprotect For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(2).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If With Worksheets("someworksheet") .Unprotect password:="" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy DestCell.PasteSpecial Paste:=xlPasteValues .Protect password:="" End With Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next Wks End Sub Unfortunately, I get the message "subscript out of range". Please help. Woulf it help if we communicate directly via emails?. Once we (well you) have cracked it I would still post the full result to the newsgroup just in case it is usefull to other people? "Dave Peterson" wrote: First, by directing this to me, you do limit the number of response from others. And that will hurt you in the long run--lots of people could have helped. Second, you have to unprotect the worksheet. activesheet.unprotect password:="yourpasswordhere" (I don't recall if this was for the activesheet or some other sheet, though.) But from the snippet of code you posted, it should fit in right before this line: .unprotect password:="yourpasswordhere" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell .protect password:="yourpasswordhere" And if you only want the values, you can either copy|paste special values or just assign the value. dim myRngToCopy as range '...some more code with worksheets("someworksheet") .unprotect password:="yourpasswordhere" set myrngtocopy = .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)) destcell.resize(myrngtocopy.rows.count,myrngtocopy .columns.count).value _ = myrngtocopy.value .protect password:="yourpasswordhere" end with ====== or equivalently: with worksheets("someworksheet") .unprotect password:="yourpasswordhere" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).copy destcell.pastespecial paste:=xlpastevalues .protect password:="yourpasswordhere" end with I like the assignment of values myself. Ann wrote: Dave, I have finally, got round to testing the code that you were kind enough to provide. Having run the code I get the message "Run Time error 1004, You cannot use this command on a protected sheet. To unprotect ....". When I click on the debug statement it points to the line with the following code:- .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell I inserted "ActiveWorkbook.Unprotect" prior to the above statement and also prior to the first IF statement, but unfortunately this does not resolve the problem. It has managed to copy the first sheet, inserted the data onto a new sheet and then produces the above message. Lastly, on the copy how do I change it so that it does a special and copies values as opposed to formulas. Help much appreciated. "Pank Mehta" wrote: Copying multiple sheets from one book 2 another and undertake special editing. Apologies as the following is long winded. I have a workbook that has 12 sheets (i.e. 1 for each month of the Year). Each sheet contains the following: - Header row; Customer name; date contacted and work location (and other information). One can have multiple rows for each customer as they can contact us many times a day for work to be undertaken at different locations. On a monthly basis we have to undertake a charging process for customers who have used our services for the last month. At the moment we all copy the information from each monthly sheet to another workbook and sort it on Customer name. Having sorted the information, someone manually creates a worksheet for each customer using Cut + Paste and then creates an invoice. Things have now changed and we have to charge on a quarterly basis. Is there any way that a front-end screen can be written in which one specifies sheet names that need to be charged for and a destination sheet name. Once the sheet names have been entered, we would like the appropriate sheets (may be selected columns) to be copied to an existing workbook (using Paste special and Values) with the name specified as destination. Obviously once the sheets have been copied, there will be three headers, I would ideally like to search the destination sheet and delete the extra 2 headers automatically before it is sorted in the format that is required. Having sorted the sheet, we would like to create individual sheets for all the different customers that exist on the master sheet and have all rows for that customer copied into their named sheet. Any help offered would be most appreciated. -- Dave Peterson -- Dave Peterson |
#10
|
|||
|
|||
Dave,
Having copied the latest code I get a "400" error. "Dave Peterson" wrote: That snippet could have been editted when you merged it with the existing code: Option Explicit Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False ActiveWorkbook.Unprotect For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(2).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If .Unprotect password:="" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy DestCell.PasteSpecial Paste:=xlPasteValues .Protect password:="" Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next Wks End Sub I deleted the "With Worksheets("someworksheet")" and associated "end with" statements. Pank Mehta wrote: Dave, Sorry to be a pain in A**E. The code I have is:- Option Explicit Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False ActiveWorkbook.Unprotect For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(2).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If With Worksheets("someworksheet") .Unprotect password:="" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy DestCell.PasteSpecial Paste:=xlPasteValues .Protect password:="" End With Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next Wks End Sub Unfortunately, I get the message "subscript out of range". Please help. Woulf it help if we communicate directly via emails?. Once we (well you) have cracked it I would still post the full result to the newsgroup just in case it is usefull to other people? "Dave Peterson" wrote: First, by directing this to me, you do limit the number of response from others. And that will hurt you in the long run--lots of people could have helped. Second, you have to unprotect the worksheet. activesheet.unprotect password:="yourpasswordhere" (I don't recall if this was for the activesheet or some other sheet, though.) But from the snippet of code you posted, it should fit in right before this line: .unprotect password:="yourpasswordhere" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell .protect password:="yourpasswordhere" And if you only want the values, you can either copy|paste special values or just assign the value. dim myRngToCopy as range '...some more code with worksheets("someworksheet") .unprotect password:="yourpasswordhere" set myrngtocopy = .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)) destcell.resize(myrngtocopy.rows.count,myrngtocopy .columns.count).value _ = myrngtocopy.value .protect password:="yourpasswordhere" end with ====== or equivalently: with worksheets("someworksheet") .unprotect password:="yourpasswordhere" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).copy destcell.pastespecial paste:=xlpastevalues .protect password:="yourpasswordhere" end with I like the assignment of values myself. Ann wrote: Dave, I have finally, got round to testing the code that you were kind enough to provide. Having run the code I get the message "Run Time error 1004, You cannot use this command on a protected sheet. To unprotect ....". When I click on the debug statement it points to the line with the following code:- .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell I inserted "ActiveWorkbook.Unprotect" prior to the above statement and also prior to the first IF statement, but unfortunately this does not resolve the problem. It has managed to copy the first sheet, inserted the data onto a new sheet and then produces the above message. Lastly, on the copy how do I change it so that it does a special and copies values as opposed to formulas. Help much appreciated. "Pank Mehta" wrote: Copying multiple sheets from one book 2 another and undertake special editing. Apologies as the following is long winded. I have a workbook that has 12 sheets (i.e. 1 for each month of the Year). Each sheet contains the following: - Header row; Customer name; date contacted and work location (and other information). One can have multiple rows for each customer as they can contact us many times a day for work to be undertaken at different locations. On a monthly basis we have to undertake a charging process for customers who have used our services for the last month. At the moment we all copy the information from each monthly sheet to another workbook and sort it on Customer name. Having sorted the information, someone manually creates a worksheet for each customer using Cut + Paste and then creates an invoice. Things have now changed and we have to charge on a quarterly basis. Is there any way that a front-end screen can be written in which one specifies sheet names that need to be charged for and a destination sheet name. Once the sheet names have been entered, we would like the appropriate sheets (may be selected columns) to be copied to an existing workbook (using Paste special and Values) with the name specified as destination. Obviously once the sheets have been copied, there will be three headers, I would ideally like to search the destination sheet and delete the extra 2 headers automatically before it is sorted in the format that is required. Having sorted the sheet, we would like to create individual sheets for all the different customers that exist on the master sheet and have all rows for that customer copied into their named sheet. Any help offered would be most appreciated. -- Dave Peterson -- Dave Peterson |
#11
|
|||
|
|||
Any idea which line caused the error?
I didn't get any error when I ran it. But I like this version better--destcell is pointing to the correct sheet. You dropped some code from the original and I didn't notice it in your newer versions. Option Explicit Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets ActiveWorkbook.Worksheets(1).Select If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False ActiveWorkbook.Unprotect For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(2).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If .Unprotect Password:="" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy DestCell.PasteSpecial Paste:=xlPasteValues .Protect Password:="" With newWks Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With End With Next Wks End Sub Pank Mehta wrote: Dave, Having copied the latest code I get a "400" error. "Dave Peterson" wrote: That snippet could have been editted when you merged it with the existing code: Option Explicit Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False ActiveWorkbook.Unprotect For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(2).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If .Unprotect password:="" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy DestCell.PasteSpecial Paste:=xlPasteValues .Protect password:="" Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next Wks End Sub I deleted the "With Worksheets("someworksheet")" and associated "end with" statements. Pank Mehta wrote: Dave, Sorry to be a pain in A**E. The code I have is:- Option Explicit Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False ActiveWorkbook.Unprotect For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(2).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If With Worksheets("someworksheet") .Unprotect password:="" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy DestCell.PasteSpecial Paste:=xlPasteValues .Protect password:="" End With Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next Wks End Sub Unfortunately, I get the message "subscript out of range". Please help. Woulf it help if we communicate directly via emails?. Once we (well you) have cracked it I would still post the full result to the newsgroup just in case it is usefull to other people? "Dave Peterson" wrote: First, by directing this to me, you do limit the number of response from others. And that will hurt you in the long run--lots of people could have helped. Second, you have to unprotect the worksheet. activesheet.unprotect password:="yourpasswordhere" (I don't recall if this was for the activesheet or some other sheet, though.) But from the snippet of code you posted, it should fit in right before this line: .unprotect password:="yourpasswordhere" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell .protect password:="yourpasswordhere" And if you only want the values, you can either copy|paste special values or just assign the value. dim myRngToCopy as range '...some more code with worksheets("someworksheet") .unprotect password:="yourpasswordhere" set myrngtocopy = .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)) destcell.resize(myrngtocopy.rows.count,myrngtocopy .columns.count).value _ = myrngtocopy.value .protect password:="yourpasswordhere" end with ====== or equivalently: with worksheets("someworksheet") .unprotect password:="yourpasswordhere" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).copy destcell.pastespecial paste:=xlpastevalues .protect password:="yourpasswordhere" end with I like the assignment of values myself. Ann wrote: Dave, I have finally, got round to testing the code that you were kind enough to provide. Having run the code I get the message "Run Time error 1004, You cannot use this command on a protected sheet. To unprotect ....". When I click on the debug statement it points to the line with the following code:- .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell I inserted "ActiveWorkbook.Unprotect" prior to the above statement and also prior to the first IF statement, but unfortunately this does not resolve the problem. It has managed to copy the first sheet, inserted the data onto a new sheet and then produces the above message. Lastly, on the copy how do I change it so that it does a special and copies values as opposed to formulas. Help much appreciated. "Pank Mehta" wrote: Copying multiple sheets from one book 2 another and undertake special editing. Apologies as the following is long winded. I have a workbook that has 12 sheets (i.e. 1 for each month of the Year). Each sheet contains the following: - Header row; Customer name; date contacted and work location (and other information). One can have multiple rows for each customer as they can contact us many times a day for work to be undertaken at different locations. On a monthly basis we have to undertake a charging process for customers who have used our services for the last month. At the moment we all copy the information from each monthly sheet to another workbook and sort it on Customer name. Having sorted the information, someone manually creates a worksheet for each customer using Cut + Paste and then creates an invoice. Things have now changed and we have to charge on a quarterly basis. Is there any way that a front-end screen can be written in which one specifies sheet names that need to be charged for and a destination sheet name. Once the sheet names have been entered, we would like the appropriate sheets (may be selected columns) to be copied to an existing workbook (using Paste special and Values) with the name specified as destination. Obviously once the sheets have been copied, there will be three headers, I would ideally like to search the destination sheet and delete the extra 2 headers automatically before it is sorted in the format that is required. Having sorted the sheet, we would like to create individual sheets for all the different customers that exist on the master sheet and have all rows for that customer copied into their named sheet. Any help offered would be most appreciated. -- Dave Peterson -- Dave Peterson -- Dave Peterson |
#12
|
|||
|
|||
Dave,
Firstly, many thanks for your time, patient and perseverance. I created a macro name called EOM (as opposed to ALT+11 ) and it worked. However, I have the following observation: - The header row from each sheet (row 2) is copied into the new sheet, which I dont want. (Can this be fixed?), if not I can delete them manually (rows 1 & 2 on all sheets are headers, data only commences in row 3 onwards. Basically it puts 4 headers into the new sheet, I only want 1. Secondly, I have created a macro to undertake some formatting and copied the code into the macro code you provided and it works. The code looks like:- ActiveWindow.Zoom = 67 Columns("B:B").Select Selection.NumberFormat = "dd/mm/yy" Columns("D:D").Select Selection.NumberFormat = "dd/mm/yy" Columns("I:I").Select Selection.NumberFormat = "dd/mm/yy" Columns("J:J").Select Selection.NumberFormat = "hh:mm AM/PM" Columns("A:A").EntireColumn.AutoFit Columns("C:C").EntireColumn.AutoFit Columns("E:E").EntireColumn.AutoFit Columns("F:F").EntireColumn.AutoFit Columns("H:H").EntireColumn.AutoFit Columns("K:K").EntireColumn.AutoFit Columns("G:G").Select Selection.Replace What:=" /", Replacement:="/", LookAt:=xlPart, _ SearchOrder:=xlByColumns, MatchCase:=False Cells.Select Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("G2") _ , Order2:=xlAscending, Key3:=Range("F2"), Order3:=xlAscending, Header:= _ xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Is there a way to make this code more efficient, as I have been lead to believe that you dont necessarily have to do the selects? Lastly, the contents of the new sheet are as follows in column A:- Company A Company A Company B Company B Company B Company C Company C Company C Company E Company E Etc. Is there any way that I can automatically get a sheet set up for each Company A, B, C, €¦with all data in to their corresponding sheets? Including a header? i.e. From the example above:- Sheet called Company A with data for 2 rows into the sheet plus header at the top Sheet called Company B with data for 3 rows into the sheet plus header at the top Sheet called Company C with data for 3 rows into the sheet plus header at the top Sheet called Company E with data for 2 rows into the sheet plus header at the top Once again a ver big thank you. "Dave Peterson" wrote: Any idea which line caused the error? I didn't get any error when I ran it. But I like this version better--destcell is pointing to the correct sheet. You dropped some code from the original and I didn't notice it in your newer versions. Option Explicit Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets ActiveWorkbook.Worksheets(1).Select If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False ActiveWorkbook.Unprotect For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(2).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If .Unprotect Password:="" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy DestCell.PasteSpecial Paste:=xlPasteValues .Protect Password:="" With newWks Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With End With Next Wks End Sub Pank Mehta wrote: Dave, Having copied the latest code I get a "400" error. "Dave Peterson" wrote: That snippet could have been editted when you merged it with the existing code: Option Explicit Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False ActiveWorkbook.Unprotect For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(2).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If .Unprotect password:="" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy DestCell.PasteSpecial Paste:=xlPasteValues .Protect password:="" Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next Wks End Sub I deleted the "With Worksheets("someworksheet")" and associated "end with" statements. Pank Mehta wrote: Dave, Sorry to be a pain in A**E. The code I have is:- Option Explicit Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False ActiveWorkbook.Unprotect For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else .Rows(2).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If With Worksheets("someworksheet") .Unprotect password:="" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy DestCell.PasteSpecial Paste:=xlPasteValues .Protect password:="" End With Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next Wks End Sub Unfortunately, I get the message "subscript out of range". Please help. Woulf it help if we communicate directly via emails?. Once we (well you) have cracked it I would still post the full result to the newsgroup just in case it is usefull to other people? "Dave Peterson" wrote: First, by directing this to me, you do limit the number of response from others. And that will hurt you in the long run--lots of people could have helped. Second, you have to unprotect the worksheet. activesheet.unprotect password:="yourpasswordhere" (I don't recall if this was for the activesheet or some other sheet, though.) But from the snippet of code you posted, it should fit in right before this line: .unprotect password:="yourpasswordhere" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell .protect password:="yourpasswordhere" And if you only want the values, you can either copy|paste special values or just assign the value. dim myRngToCopy as range '...some more code with worksheets("someworksheet") .unprotect password:="yourpasswordhere" set myrngtocopy = .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)) destcell.resize(myrngtocopy.rows.count,myrngtocopy .columns.count).value _ = myrngtocopy.value .protect password:="yourpasswordhere" end with ====== or equivalently: with worksheets("someworksheet") .unprotect password:="yourpasswordhere" .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).copy destcell.pastespecial paste:=xlpastevalues .protect password:="yourpasswordhere" end with I like the assignment of values myself. Ann wrote: Dave, I have finally, got round to testing the code that you were kind enough to provide. Having run the code I get the message "Run Time error 1004, You cannot use this command on a protected sheet. To unprotect ....". When I click on the debug statement it points to the line with the following code:- .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Destination:=DestCell I inserted "ActiveWorkbook.Unprotect" prior to the above statement and also prior to the first IF statement, but unfortunately this does not resolve the problem. It has managed to copy the first sheet, inserted the data onto a new sheet and then produces the above message. Lastly, on the copy how do I change it so that it does a special and copies values as opposed to formulas. Help much appreciated. "Pank Mehta" wrote: Copying multiple sheets from one book 2 another and undertake special editing. Apologies as the following is long winded. I have a workbook that has 12 sheets (i.e. 1 for each month of the Year). Each sheet contains the following: - Header row; Customer name; date contacted and work location (and other information). One can have multiple rows for each customer as they can contact us many times a day for work to be undertaken at different locations. On a monthly basis we have to undertake a charging process for customers who have used our services for the last month. At the moment we all copy the information from each monthly sheet to another workbook and sort it on Customer name. Having sorted the information, someone manually creates a worksheet for each customer using Cut + Paste and then creates an invoice. Things have now changed and we have to charge on a quarterly basis. Is there any way that a front-end screen can be written in which one specifies sheet names that need to be charged for and a destination sheet name. Once the sheet names have been entered, we would like the appropriate sheets (may be selected columns) to be copied to an existing workbook (using Paste special and Values) with the name specified as destination. Obviously once the sheets have been copied, there will be three headers, I would ideally like to search the destination sheet and delete the extra 2 headers automatically before it is sorted in the format that is required. Having sorted the sheet, we would like to create individual sheets for all the different customers that exist on the master sheet and have all rows for that customer copied into their named sheet. Any help offered would be most appreciated. -- Dave Peterson -- Dave Peterson -- Dave Peterson |
#13
|
|||
|
|||
You've got to be more careful when you modify the code <vbg.
The original code just copied rows(1) as the header. You changed it to rows(2). But you didn't change the start of the details from A2 to A3. so maybe this would work better: Option Explicit Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets ActiveWorkbook.Worksheets(1).Select If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False ActiveWorkbook.Unprotect For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else 'for both rows 1 & 2, use .rows("1:2").copy _ 'instead of the next line .Rows(2).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If .Unprotect Password:="" .Range("a3", .Cells.SpecialCells(xlCellTypeLastCell)).Copy DestCell.PasteSpecial Paste:=xlPasteValues .Protect Password:="" With newWks Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With End With Next Wks End Sub And you're formatting the new worksheet?? With newwks .Select 'just for the .zoom to work. ActiveWindow.Zoom = 67 .Range("b:b,d:d,I:i").NumberFormat = "dd/mm/yy" .Range("j:j").NumberFormat = "hh:mm AM/PM" .UsedRange.Columns.AutoFit 'or .Range("a:a,c:c,e:e,H:h,k:k").EntireColumn.AutoFit With .Range("g:g") .Replace What:=" /", Replacement:="/", _ LookAt:=xlPart, _ SearchOrder:=xlByColumns, _ MatchCase:=False End With With .UsedRange .Sort key1:=.Range("a1"), Order1:=xlAscending, _ Key2:=.Range("G1"), Order2:=xlAscending, _ Key3:=.Range("F2"), Order3:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom End With End With But watch out for that last sort. This code is sorting from Row 1 (headers in row 1). You may want this (or a variation): With .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)) .Sort key1:=.Range("a1"), Order1:=xlAscending, _ Key2:=.Range("G1"), Order2:=xlAscending, _ Key3:=.Range("F2"), Order3:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom End With Use the last row that contains headers in that "A2" reference. And finally, you may be able to use Ron de Bruin's EasyFilter addin: http://www.rondebruin.nl/easyfilter.htm Or you could steal some code from Debra Dalgleish's site: http://www.contextures.com/excelfiles.html Create New Sheets from Filtered List -- uses an Advanced Filter to create separate sheet of orders for each sales rep visible in a filtered list; macro automates the filter. AdvFilterRepFiltered.xls 35 kb Update Sheets from Master -- uses an Advanced Filter to send data from Master sheet to individual worksheets -- replaces old data with current. AdvFilterCity.xls 55 kb Pank Mehta wrote: Dave, Firstly, many thanks for your time, patient and perseverance. I created a macro name called EOM (as opposed to ALT+11 ) and it worked. However, I have the following observation: - The header row from each sheet (row 2) is copied into the new sheet, which I dont want. (Can this be fixed?), if not I can delete them manually (rows 1 & 2 on all sheets are headers, data only commences in row 3 onwards. Basically it puts 4 headers into the new sheet, I only want 1. Secondly, I have created a macro to undertake some formatting and copied the code into the macro code you provided and it works. The code looks like:- ActiveWindow.Zoom = 67 Columns("B:B").Select Selection.NumberFormat = "dd/mm/yy" Columns("D:D").Select Selection.NumberFormat = "dd/mm/yy" Columns("I:I").Select Selection.NumberFormat = "dd/mm/yy" Columns("J:J").Select Selection.NumberFormat = "hh:mm AM/PM" Columns("A:A").EntireColumn.AutoFit Columns("C:C").EntireColumn.AutoFit Columns("E:E").EntireColumn.AutoFit Columns("F:F").EntireColumn.AutoFit Columns("H:H").EntireColumn.AutoFit Columns("K:K").EntireColumn.AutoFit Columns("G:G").Select Selection.Replace What:=" /", Replacement:="/", LookAt:=xlPart, _ SearchOrder:=xlByColumns, MatchCase:=False Cells.Select Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("G2") _ , Order2:=xlAscending, Key3:=Range("F2"), Order3:=xlAscending, Header:= _ xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Is there a way to make this code more efficient, as I have been lead to believe that you dont necessarily have to do the selects? Lastly, the contents of the new sheet are as follows in column A:- Company A Company A Company B Company B Company B Company C Company C Company C Company E Company E Etc. Is there any way that I can automatically get a sheet set up for each Company A, B, C, €¦with all data in to their corresponding sheets? Including a header? i.e. From the example above:- Sheet called Company A with data for 2 rows into the sheet plus header at the top Sheet called Company B with data for 3 rows into the sheet plus header at the top Sheet called Company C with data for 3 rows into the sheet plus header at the top Sheet called Company E with data for 2 rows into the sheet plus header at the top Once again a ver big thank you. <<snipped |
#14
|
|||
|
|||
Dave,
It worked a treat and exactly what was required. Please accept my sincere thanks for you sterling effort considering I was sometimes a pain in the a**e. As you have suggested I will look at Ron and Debras sites to take the work to the next logical level to complete the work. Once again many many thanks, and I will post something in the discussion groups that may help others. "Dave Peterson" wrote: You've got to be more careful when you modify the code <vbg. The original code just copied rows(1) as the header. You changed it to rows(2). But you didn't change the start of the details from A2 to A3. so maybe this would work better: Option Explicit Sub EOM() Dim Wks As Worksheet Dim DestCell As Range Dim newWks As Worksheet Dim HeadersAreDone As Boolean Dim mySelectedSheets As Object Dim myRngToCopy As Range Set mySelectedSheets = ActiveWindow.SelectedSheets ActiveWorkbook.Worksheets(1).Select If mySelectedSheets.Count < 3 Then MsgBox "Please Group exactly 3 sheets before you run this macro!" Exit Sub End If Set newWks = Workbooks.Add(1).Worksheets(1) HeadersAreDone = False ActiveWorkbook.Unprotect For Each Wks In mySelectedSheets With Wks If HeadersAreDone = True Then 'do nothing Else 'for both rows 1 & 2, use .rows("1:2").copy _ 'instead of the next line .Rows(2).Copy _ Destination:=newWks.Range("a1") HeadersAreDone = True Set DestCell = newWks.Range("a2") End If .Unprotect Password:="" .Range("a3", .Cells.SpecialCells(xlCellTypeLastCell)).Copy DestCell.PasteSpecial Paste:=xlPasteValues .Protect Password:="" With newWks Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With End With Next Wks End Sub And you're formatting the new worksheet?? With newwks .Select 'just for the .zoom to work. ActiveWindow.Zoom = 67 .Range("b:b,d:d,I:i").NumberFormat = "dd/mm/yy" .Range("j:j").NumberFormat = "hh:mm AM/PM" .UsedRange.Columns.AutoFit 'or .Range("a:a,c:c,e:e,H:h,k:k").EntireColumn.AutoFit With .Range("g:g") .Replace What:=" /", Replacement:="/", _ LookAt:=xlPart, _ SearchOrder:=xlByColumns, _ MatchCase:=False End With With .UsedRange .Sort key1:=.Range("a1"), Order1:=xlAscending, _ Key2:=.Range("G1"), Order2:=xlAscending, _ Key3:=.Range("F2"), Order3:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom End With End With But watch out for that last sort. This code is sorting from Row 1 (headers in row 1). You may want this (or a variation): With .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)) .Sort key1:=.Range("a1"), Order1:=xlAscending, _ Key2:=.Range("G1"), Order2:=xlAscending, _ Key3:=.Range("F2"), Order3:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom End With Use the last row that contains headers in that "A2" reference. And finally, you may be able to use Ron de Bruin's EasyFilter addin: http://www.rondebruin.nl/easyfilter.htm Or you could steal some code from Debra Dalgleish's site: http://www.contextures.com/excelfiles.html Create New Sheets from Filtered List -- uses an Advanced Filter to create separate sheet of orders for each sales rep visible in a filtered list; macro automates the filter. AdvFilterRepFiltered.xls 35 kb Update Sheets from Master -- uses an Advanced Filter to send data from Master sheet to individual worksheets -- replaces old data with current. AdvFilterCity.xls 55 kb Pank Mehta wrote: Dave, Firstly, many thanks for your time, patient and perseverance. I created a macro name called EOM (as opposed to ALT+11 ) and it worked. However, I have the following observation: - The header row from each sheet (row 2) is copied into the new sheet, which I don€„¢t want. (Can this be fixed?), if not I can delete them manually (rows 1 & 2 on all sheets are headers, data only commences in row 3 onwards. Basically it puts 4 headers into the new sheet, I only want 1. Secondly, I have created a macro to undertake some formatting and copied the code into the macro code you provided and it works. The code looks like:- ActiveWindow.Zoom = 67 Columns("B:B").Select Selection.NumberFormat = "dd/mm/yy" Columns("D:D").Select Selection.NumberFormat = "dd/mm/yy" Columns("I:I").Select Selection.NumberFormat = "dd/mm/yy" Columns("J:J").Select Selection.NumberFormat = "hh:mm AM/PM" Columns("A:A").EntireColumn.AutoFit Columns("C:C").EntireColumn.AutoFit Columns("E:E").EntireColumn.AutoFit Columns("F:F").EntireColumn.AutoFit Columns("H:H").EntireColumn.AutoFit Columns("K:K").EntireColumn.AutoFit Columns("G:G").Select Selection.Replace What:=" /", Replacement:="/", LookAt:=xlPart, _ SearchOrder:=xlByColumns, MatchCase:=False Cells.Select Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("G2") _ , Order2:=xlAscending, Key3:=Range("F2"), Order3:=xlAscending, Header:= _ xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Is there a way to make this code more efficient, as I have been lead to believe that you don€„¢t necessarily have to do the selects? Lastly, the contents of the new sheet are as follows in column A:- Company A Company A Company B Company B Company B Company C Company C Company C Company E Company E Etc. Is there any way that I can automatically get a sheet set up for each Company A, B, C, €¦with all data in to their corresponding sheets? Including a header? i.e. From the example above:- Sheet called Company A with data for 2 rows into the sheet plus header at the top Sheet called Company B with data for 3 rows into the sheet plus header at the top Sheet called Company C with data for 3 rows into the sheet plus header at the top Sheet called Company E with data for 2 rows into the sheet plus header at the top Once again a ver big thank you. <<snipped |
#15
|
|||
|
|||
Glad you got it working. And that's a very nice attitude.
Pank Mehta wrote: Dave, It worked a treat and exactly what was required. Please accept my sincere thanks for you sterling effort considering I was sometimes a pain in the a**e. As you have suggested I will look at Ron and Debras sites to take the work to the next logical level to complete the work. Once again many many thanks, and I will post something in the discussion groups that may help others. <<snipped |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|