Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
macro to create, name sheet and copy.
Could someone please help me modify the following macro and use.
In this Macro the range is set as every 20 raws. I like to use with data that has different size range. Can I set a page break for each company range and use? If so how to change below/ Thanks Private Sub XfrCompPL() Dim rngC1 As Range ' the range for Company Dim nCol As Long ' number of columns Dim strCName As String ' company name Dim wsC1 As Worksheet ' target new worksheet name nCol = ActiveSheet.UsedRange.Columns.Count Set rngC1 = ActiveSheet.UsedRange.Range("A1") ' first cell Do While rngC1.Value < "" strCName = Split(rngC1.Value, " ")(0) ' first word is company Set rngC1 = rngC1.Resize(20, nCol) ' range is the company's Set wsC1 = Worksheets.Add(after:=Worksheets(Worksheets.Count) ) ' wsC1.Name = strCName ' name the sheet rngC1.Copy Destination:=wsC1.[A1] ' copy to it Set rngC1 = rngC1.Range("A1").Offset(20) ' next company Loop End Sub |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
macro to create, name sheet and copy.
Private Sub XfrCompPL()
Dim rngC1 As Range ' the range for Company Dim FirstRow As Long Dim RowCount As Long Dim NewCName As String ' company name Dim OldCName As String ' company name Dim wsC1 As Worksheet ' target new worksheet name Set OldSht = ActiveSheet FirstRow = 1 LastRow = OldSht.Range("A" & Rows.Count).End(xlUp).Row OldCName = Split(OldSht.Range("A1").Value, " ")(0) For RowCount = 1 To LastRow NewCName = Split(OldSht.Range("A" & (RowCount + 1)).Value, " ")(0) If OldCName < NewCName Then Set wsC1 = Worksheets.Add(after:=Worksheets(Worksheets.Count) ) ' wsC1.Name = OldCName ' name the sheet Set rngC1 = OldSht.Rows(FirstRow & ":" & RowCount) rngC1.Copy Destination:=wsC1.Rows(1) ' copy to it FirstRow = RowCount + 1 OldCName = NewCName End If Next RowCount End Sub "sutha" wrote: Could someone please help me modify the following macro and use. In this Macro the range is set as every 20 raws. I like to use with data that has different size range. Can I set a page break for each company range and use? If so how to change below/ Thanks Private Sub XfrCompPL() Dim rngC1 As Range ' the range for Company Dim nCol As Long ' number of columns Dim strCName As String ' company name Dim wsC1 As Worksheet ' target new worksheet name nCol = ActiveSheet.UsedRange.Columns.Count Set rngC1 = ActiveSheet.UsedRange.Range("A1") ' first cell Do While rngC1.Value < "" strCName = Split(rngC1.Value, " ")(0) ' first word is company Set rngC1 = rngC1.Resize(20, nCol) ' range is the company's Set wsC1 = Worksheets.Add(after:=Worksheets(Worksheets.Count) ) ' wsC1.Name = strCName ' name the sheet rngC1.Copy Destination:=wsC1.[A1] ' copy to it Set rngC1 = rngC1.Range("A1").Offset(20) ' next company Loop End Sub |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
macro to create, name sheet and copy.
Thanks Joel.
I copied and ran and got an error message as"run time error'9' subscript out of range. Please bear with me. I am not with macro knowledge. Your help is much appreciated. "Joel" wrote: Private Sub XfrCompPL() Dim rngC1 As Range ' the range for Company Dim FirstRow As Long Dim RowCount As Long Dim NewCName As String ' company name Dim OldCName As String ' company name Dim wsC1 As Worksheet ' target new worksheet name Set OldSht = ActiveSheet FirstRow = 1 LastRow = OldSht.Range("A" & Rows.Count).End(xlUp).Row OldCName = Split(OldSht.Range("A1").Value, " ")(0) For RowCount = 1 To LastRow NewCName = Split(OldSht.Range("A" & (RowCount + 1)).Value, " ")(0) If OldCName < NewCName Then Set wsC1 = Worksheets.Add(after:=Worksheets(Worksheets.Count) ) ' wsC1.Name = OldCName ' name the sheet Set rngC1 = OldSht.Rows(FirstRow & ":" & RowCount) rngC1.Copy Destination:=wsC1.Rows(1) ' copy to it FirstRow = RowCount + 1 OldCName = NewCName End If Next RowCount End Sub "sutha" wrote: Could someone please help me modify the following macro and use. In this Macro the range is set as every 20 raws. I like to use with data that has different size range. Can I set a page break for each company range and use? If so how to change below/ Thanks Private Sub XfrCompPL() Dim rngC1 As Range ' the range for Company Dim nCol As Long ' number of columns Dim strCName As String ' company name Dim wsC1 As Worksheet ' target new worksheet name nCol = ActiveSheet.UsedRange.Columns.Count Set rngC1 = ActiveSheet.UsedRange.Range("A1") ' first cell Do While rngC1.Value < "" strCName = Split(rngC1.Value, " ")(0) ' first word is company Set rngC1 = rngC1.Resize(20, nCol) ' range is the company's Set wsC1 = Worksheets.Add(after:=Worksheets(Worksheets.Count) ) ' wsC1.Name = strCName ' name the sheet rngC1.Copy Destination:=wsC1.[A1] ' copy to it Set rngC1 = rngC1.Range("A1").Offset(20) ' next company Loop End Sub |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
macro to create, name sheet and copy.
there are two reasons Error 9 can occur
1) The sheet with original sheet with data wasn't selected. I made the following change in my new code below from Set OldSht = ActiveSheet to Set OldSht = Sheets("Sheet1") Note : change Sheet1 t the sheet where your original data is located. 2) An error will occur on the last row of data because the next row contains an empty cell in Column A. Split produces an error when the string is empty This line created the error NewCName = Split(OldSht.Range("A" & (RowCount + 1)).Value, " ")(0) I added a new test in the code below checking if the cell is empty on the next row. Private Sub XfrCompPL() Dim rngC1 As Range ' the range for Company Dim FirstRow As Long Dim RowCount As Long Dim NewCName As String ' company name Dim OldCName As String ' company name Dim wsC1 As Worksheet ' target new worksheet name Set OldSht = Sheets("Sheet1") FirstRow = 1 LastRow = OldSht.Range("A" & Rows.Count).End(xlUp).Row OldCName = Split(OldSht.Range("A1").Value, " ")(0) For RowCount = 1 To LastRow If OldSht.Range("A" & (RowCount + 1)) = "" Then NewCName = "" Else NewCName = Split(OldSht.Range("A" & (RowCount + 1)).Value, " ")(0) End If If OldCName < NewCName Then Set wsC1 = Worksheets.Add(after:=Worksheets(Worksheets.Count) ) ' wsC1.Name = OldCName ' name the sheet Set rngC1 = OldSht.Rows(FirstRow & ":" & RowCount) rngC1.Copy Destination:=wsC1.Rows(1) ' copy to it FirstRow = RowCount + 1 OldCName = NewCName End If Next RowCount End Sub "sutha" wrote: Thanks Joel. I copied and ran and got an error message as"run time error'9' subscript out of range. Please bear with me. I am not with macro knowledge. Your help is much appreciated. "Joel" wrote: Private Sub XfrCompPL() Dim rngC1 As Range ' the range for Company Dim FirstRow As Long Dim RowCount As Long Dim NewCName As String ' company name Dim OldCName As String ' company name Dim wsC1 As Worksheet ' target new worksheet name Set OldSht = ActiveSheet FirstRow = 1 LastRow = OldSht.Range("A" & Rows.Count).End(xlUp).Row OldCName = Split(OldSht.Range("A1").Value, " ")(0) For RowCount = 1 To LastRow NewCName = Split(OldSht.Range("A" & (RowCount + 1)).Value, " ")(0) If OldCName < NewCName Then Set wsC1 = Worksheets.Add(after:=Worksheets(Worksheets.Count) ) ' wsC1.Name = OldCName ' name the sheet Set rngC1 = OldSht.Rows(FirstRow & ":" & RowCount) rngC1.Copy Destination:=wsC1.Rows(1) ' copy to it FirstRow = RowCount + 1 OldCName = NewCName End If Next RowCount End Sub "sutha" wrote: Could someone please help me modify the following macro and use. In this Macro the range is set as every 20 raws. I like to use with data that has different size range. Can I set a page break for each company range and use? If so how to change below/ Thanks Private Sub XfrCompPL() Dim rngC1 As Range ' the range for Company Dim nCol As Long ' number of columns Dim strCName As String ' company name Dim wsC1 As Worksheet ' target new worksheet name nCol = ActiveSheet.UsedRange.Columns.Count Set rngC1 = ActiveSheet.UsedRange.Range("A1") ' first cell Do While rngC1.Value < "" strCName = Split(rngC1.Value, " ")(0) ' first word is company Set rngC1 = rngC1.Resize(20, nCol) ' range is the company's Set wsC1 = Worksheets.Add(after:=Worksheets(Worksheets.Count) ) ' wsC1.Name = strCName ' name the sheet rngC1.Copy Destination:=wsC1.[A1] ' copy to it Set rngC1 = rngC1.Range("A1").Offset(20) ' next company Loop End Sub |
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
macro to create, name sheet and copy.
Works perfectly. I rated as helpful.
Thanks "Joel" wrote: there are two reasons Error 9 can occur 1) The sheet with original sheet with data wasn't selected. I made the following change in my new code below from Set OldSht = ActiveSheet to Set OldSht = Sheets("Sheet1") Note : change Sheet1 t the sheet where your original data is located. 2) An error will occur on the last row of data because the next row contains an empty cell in Column A. Split produces an error when the string is empty This line created the error NewCName = Split(OldSht.Range("A" & (RowCount + 1)).Value, " ")(0) I added a new test in the code below checking if the cell is empty on the next row. Private Sub XfrCompPL() Dim rngC1 As Range ' the range for Company Dim FirstRow As Long Dim RowCount As Long Dim NewCName As String ' company name Dim OldCName As String ' company name Dim wsC1 As Worksheet ' target new worksheet name Set OldSht = Sheets("Sheet1") FirstRow = 1 LastRow = OldSht.Range("A" & Rows.Count).End(xlUp).Row OldCName = Split(OldSht.Range("A1").Value, " ")(0) For RowCount = 1 To LastRow If OldSht.Range("A" & (RowCount + 1)) = "" Then NewCName = "" Else NewCName = Split(OldSht.Range("A" & (RowCount + 1)).Value, " ")(0) End If If OldCName < NewCName Then Set wsC1 = Worksheets.Add(after:=Worksheets(Worksheets.Count) ) ' wsC1.Name = OldCName ' name the sheet Set rngC1 = OldSht.Rows(FirstRow & ":" & RowCount) rngC1.Copy Destination:=wsC1.Rows(1) ' copy to it FirstRow = RowCount + 1 OldCName = NewCName End If Next RowCount End Sub "sutha" wrote: Thanks Joel. I copied and ran and got an error message as"run time error'9' subscript out of range. Please bear with me. I am not with macro knowledge. Your help is much appreciated. "Joel" wrote: Private Sub XfrCompPL() Dim rngC1 As Range ' the range for Company Dim FirstRow As Long Dim RowCount As Long Dim NewCName As String ' company name Dim OldCName As String ' company name Dim wsC1 As Worksheet ' target new worksheet name Set OldSht = ActiveSheet FirstRow = 1 LastRow = OldSht.Range("A" & Rows.Count).End(xlUp).Row OldCName = Split(OldSht.Range("A1").Value, " ")(0) For RowCount = 1 To LastRow NewCName = Split(OldSht.Range("A" & (RowCount + 1)).Value, " ")(0) If OldCName < NewCName Then Set wsC1 = Worksheets.Add(after:=Worksheets(Worksheets.Count) ) ' wsC1.Name = OldCName ' name the sheet Set rngC1 = OldSht.Rows(FirstRow & ":" & RowCount) rngC1.Copy Destination:=wsC1.Rows(1) ' copy to it FirstRow = RowCount + 1 OldCName = NewCName End If Next RowCount End Sub "sutha" wrote: Could someone please help me modify the following macro and use. In this Macro the range is set as every 20 raws. I like to use with data that has different size range. Can I set a page break for each company range and use? If so how to change below/ Thanks Private Sub XfrCompPL() Dim rngC1 As Range ' the range for Company Dim nCol As Long ' number of columns Dim strCName As String ' company name Dim wsC1 As Worksheet ' target new worksheet name nCol = ActiveSheet.UsedRange.Columns.Count Set rngC1 = ActiveSheet.UsedRange.Range("A1") ' first cell Do While rngC1.Value < "" strCName = Split(rngC1.Value, " ")(0) ' first word is company Set rngC1 = rngC1.Resize(20, nCol) ' range is the company's Set wsC1 = Worksheets.Add(after:=Worksheets(Worksheets.Count) ) ' wsC1.Name = strCName ' name the sheet rngC1.Copy Destination:=wsC1.[A1] ' copy to it Set rngC1 = rngC1.Range("A1").Offset(20) ' next company Loop End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
1 Create a macro to Copy & paste certain data to another sheet | Excel Discussion (Misc queries) | |||
create a macro to copy a worksheet into another | Excel Discussion (Misc queries) | |||
create macro to copy | Excel Discussion (Misc queries) | |||
I need formula help or create a macro to copy and paste value only | Excel Discussion (Misc queries) | |||
Create a Macro that will copy the rows that have a value < 0 | Excel Discussion (Misc queries) |