Request for help transfering data between sheets
Author |
Message |
Jeff #1 / 7
|
 Request for help transfering data between sheets
This is a sample of sheet of my work book Sheet1 100 1 .375 .1875 ball mill 3000 rough top 110 2 .625 0.0 end mill 3000 finish top 120 3 .500 0.0 end mill 3000 final top cut 120 3 .500 0.0 end mill 3000 cut 1 120 3 .500 0.0 end mill 3000 cut 2 130 4 1.25 0.0 end mill 5000 cut 1 130 4 1.25 0.0 end mill 5000 cut 2 140 8 1.5 0.0 end mill 8000 cut 1 140 8 1.5 0.0 end mill 8000 cut 2 The following is the macro I am using to create blanks sheets that are named the number of the value in the first columns without duplicate. This works great --------------------------------------------------------------------------- - Sub makeSheets() Dim rng As Range Dim ws As Worksheet Set rng = Sheets("Sheet1").Range("A1", Range("A1").End(xlDown)) On Error GoTo skip For Each cel In rng On Error Resume Next For Each ws In ThisWorkbook.Worksheets If ws.Name = cel.Value Then GoTo skip End If Next Worksheets.Add.Name = cel.Value skip: Next End Sub --------------------------------------------------------------------------- - But what I now need to do is copy some of this data onto those sheets created by the same macro or a call to another macro, again without duplicates You may have multiple duplicate numbers in the first column and if you do the next few columns also have the same data but the last field has differing data. So in this sheet creating loop I need to Number one; Create a blank sheet with that number as the name, then copy the data from the next 4 columns to that sheet along with the last cell. Number two; If there is another row that has the same number, we only want to copy the last cell data to the sheet of that number. Here are samples of what the additional sheets could look like. ----------------------------------------------------------- Sheet100 1 .375 .1875 ball mill 3000 rough top ----------------------------------------------------------- Sheet110 2 .625 0.0 end mill 3000 finish top ----------------------------------------------------------- Sheet120 3 .500 0.0 end mill 3000 final top cut cut 1 cut 2 ----------------------------------------------------------- Sheet130 4 1.25 0.0 end mill 5000 cut 1 cut 2 ----------------------------------------------------------- Sheet140 8 1.5 0.0 end mill 8000 cut 1 cut 2 ----------------------------------------------------------- This project has been on going for some time now and I think this is the last major improvement to be made, any help would certainly be appreciated... Thanks in advance Jeff White
|
Sun, 14 Mar 2004 04:25:05 GMT |
|
 |
Dick Kusleik #2 / 7
|
 Request for help transfering data between sheets
Jeff I changed your original sub a little because I hate GoTo's. But this sub seems to do what you want. Sub MakeSheets() Dim ws As Worksheet, Sh1 As Worksheet Dim NewSh As Worksheet Dim wb As Workbook Dim bExist As Boolean Dim cell As Range, Rng As Range Dim i As Integer Set wb = ThisWorkbook Set Sh1 = ThisWorkbook.Sheets("Sheet1") Set Rng = Sh1.Range("a1", Sh1.Range("a1").End(xlDown)) bExist = False For Each cell In Rng For Each ws In wb.Worksheets If ws.Name = cell.Value Then bExist = True End If Next ws If bExist Then wb.Sheets(CStr(cell.Value)).Range("f65000").End(xlUp). _ Offset(1, 0).Value = cell.Offset(0, 6).Value Else Set NewSh = wb.Worksheets.Add _ (after:=wb.Sheets(wb.Sheets.Count)) NewSh.Name = cell.Value For i = 0 To 5 NewSh.Range("a65000").End(xlUp).Offset(0, i).Value _ = cell.Offset(0, i + 1).Value Next i End If bExist = False Next cell End Sub HTH {*filter*} K.
Quote: > This is a sample of sheet of my work book > Sheet1 > 100 1 .375 .1875 ball mill 3000 rough top > 110 2 .625 0.0 end mill 3000 finish top > 120 3 .500 0.0 end mill 3000 final top cut > 120 3 .500 0.0 end mill 3000 cut 1 > 120 3 .500 0.0 end mill 3000 cut 2 > 130 4 1.25 0.0 end mill 5000 cut 1 > 130 4 1.25 0.0 end mill 5000 cut 2 > 140 8 1.5 0.0 end mill 8000 cut 1 > 140 8 1.5 0.0 end mill 8000 cut 2 > The following is the macro I am using to create blanks sheets > that are named the number of the value in the first columns > without duplicate. This works great > ------------------------------------------------------------------------- -- > - > Sub makeSheets() > Dim rng As Range > Dim ws As Worksheet > Set rng = Sheets("Sheet1").Range("A1", Range("A1").End(xlDown)) > On Error GoTo skip > For Each cel In rng > On Error Resume Next > For Each ws In ThisWorkbook.Worksheets > If ws.Name = cel.Value Then > GoTo skip > End If > Next > Worksheets.Add.Name = cel.Value > skip: > Next > End Sub > ------------------------------------------------------------------------- -- > - > But what I now need to do is copy some of this data onto those > sheets created by the same macro or a call to another macro, > again without duplicates > You may have multiple duplicate numbers in the first column > and if you do the next few columns also have the same data > but the last field has differing data. > So in this sheet creating loop I need to > Number one; > Create a blank sheet with that number as the name, then > copy the data from the next 4 columns to that sheet along > with the last cell. > Number two; > If there is another row that has the same number, we only want > to copy the last cell data to the sheet of that number. > Here are samples of what the additional sheets could look like. > ----------------------------------------------------------- > Sheet100 > 1 .375 .1875 ball mill 3000 rough top > ----------------------------------------------------------- > Sheet110 > 2 .625 0.0 end mill 3000 finish top > ----------------------------------------------------------- > Sheet120 > 3 .500 0.0 end mill 3000 final top cut > cut 1 > cut 2 > ----------------------------------------------------------- > Sheet130 > 4 1.25 0.0 end mill 5000 cut 1 > cut 2 > ----------------------------------------------------------- > Sheet140 > 8 1.5 0.0 end mill 8000 cut 1 > cut 2 > ----------------------------------------------------------- > This project has been on going for some time now and I think this is the > last major improvement to be made, any help would certainly be > appreciated... > Thanks in advance > Jeff White
|
Sun, 14 Mar 2004 04:56:26 GMT |
|
 |
Jeff #3 / 7
|
 Request for help transfering data between sheets
Dick, This looks great, Do you have any suggestions on how I might be able to specify a starting position for the data on the newly created sheets? Jeff White
Quote: > Jeff > I changed your original sub a little because I hate GoTo's. But this sub > seems to do what you want. > Sub MakeSheets() > Dim ws As Worksheet, Sh1 As Worksheet > Dim NewSh As Worksheet > Dim wb As Workbook > Dim bExist As Boolean > Dim cell As Range, Rng As Range > Dim i As Integer > Set wb = ThisWorkbook > Set Sh1 = ThisWorkbook.Sheets("Sheet1") > Set Rng = Sh1.Range("a1", Sh1.Range("a1").End(xlDown)) > bExist = False > For Each cell In Rng > For Each ws In wb.Worksheets > If ws.Name = cell.Value Then > bExist = True > End If > Next ws > If bExist Then > wb.Sheets(CStr(cell.Value)).Range("f65000").End(xlUp). _ > Offset(1, 0).Value = cell.Offset(0, 6).Value > Else > Set NewSh = wb.Worksheets.Add _ > (after:=wb.Sheets(wb.Sheets.Count)) > NewSh.Name = cell.Value > For i = 0 To 5 > NewSh.Range("a65000").End(xlUp).Offset(0, i).Value _ > = cell.Offset(0, i + 1).Value > Next i > End If > bExist = False > Next cell > End Sub > HTH >{*filter*} K.
> > This is a sample of sheet of my work book > > Sheet1 > > 100 1 .375 .1875 ball mill 3000 rough top > > 110 2 .625 0.0 end mill 3000 finish top > > 120 3 .500 0.0 end mill 3000 final top cut > > 120 3 .500 0.0 end mill 3000 cut 1 > > 120 3 .500 0.0 end mill 3000 cut 2 > > 130 4 1.25 0.0 end mill 5000 cut 1 > > 130 4 1.25 0.0 end mill 5000 cut 2 > > 140 8 1.5 0.0 end mill 8000 cut 1 > > 140 8 1.5 0.0 end mill 8000 cut 2 > > The following is the macro I am using to create blanks sheets > > that are named the number of the value in the first columns > > without duplicate. This works great
------------------------------------------------------------------------- Quote: > -- > > - > > Sub makeSheets() > > Dim rng As Range > > Dim ws As Worksheet > > Set rng = Sheets("Sheet1").Range("A1", Range("A1").End(xlDown)) > > On Error GoTo skip > > For Each cel In rng > > On Error Resume Next > > For Each ws In ThisWorkbook.Worksheets > > If ws.Name = cel.Value Then > > GoTo skip > > End If > > Next > > Worksheets.Add.Name = cel.Value > > skip: > > Next > > End Sub
------------------------------------------------------------------------- Quote: > -- > > - > > But what I now need to do is copy some of this data onto those > > sheets created by the same macro or a call to another macro, > > again without duplicates > > You may have multiple duplicate numbers in the first column > > and if you do the next few columns also have the same data > > but the last field has differing data. > > So in this sheet creating loop I need to > > Number one; > > Create a blank sheet with that number as the name, then > > copy the data from the next 4 columns to that sheet along > > with the last cell. > > Number two; > > If there is another row that has the same number, we only want > > to copy the last cell data to the sheet of that number. > > Here are samples of what the additional sheets could look like. > > ----------------------------------------------------------- > > Sheet100 > > 1 .375 .1875 ball mill 3000 rough top > > ----------------------------------------------------------- > > Sheet110 > > 2 .625 0.0 end mill 3000 finish top > > ----------------------------------------------------------- > > Sheet120 > > 3 .500 0.0 end mill 3000 final top cut > > cut 1 > > cut 2 > > ----------------------------------------------------------- > > Sheet130 > > 4 1.25 0.0 end mill 5000 cut 1 > > cut 2 > > ----------------------------------------------------------- > > Sheet140 > > 8 1.5 0.0 end mill 8000 cut 1 > > cut 2 > > ----------------------------------------------------------- > > This project has been on going for some time now and I think this is the > > last major improvement to be made, any help would certainly be > > appreciated... > > Thanks in advance > > Jeff White
|
Sun, 14 Mar 2004 12:06:25 GMT |
|
 |
Dick Kusleik #4 / 7
|
 Request for help transfering data between sheets
Jeff This line determines where to start on a new sheet. Quote: > > NewSh.Range("a65000").End(xlUp).Offset(0, i).Value _ > > = cell.Offset(0, i + 1).Value
If you want to start in A2 instead of A1, change the first parameter of Offset to 1. If you had something else in mind, post back and be specific. HTH {*filter*} K.
Quote: >{*filter*}, This looks great, Do you have any suggestions > on how I might be able to specify a starting position > for the data on the newly created sheets? > Jeff White
> > Jeff > > I changed your original sub a little because I hate GoTo's. But this sub > > seems to do what you want. > > Sub MakeSheets() > > Dim ws As Worksheet, Sh1 As Worksheet > > Dim NewSh As Worksheet > > Dim wb As Workbook > > Dim bExist As Boolean > > Dim cell As Range, Rng As Range > > Dim i As Integer > > Set wb = ThisWorkbook > > Set Sh1 = ThisWorkbook.Sheets("Sheet1") > > Set Rng = Sh1.Range("a1", Sh1.Range("a1").End(xlDown)) > > bExist = False > > For Each cell In Rng > > For Each ws In wb.Worksheets > > If ws.Name = cell.Value Then > > bExist = True > > End If > > Next ws > > If bExist Then > > wb.Sheets(CStr(cell.Value)).Range("f65000").End(xlUp). _ > > Offset(1, 0).Value = cell.Offset(0, 6).Value > > Else > > Set NewSh = wb.Worksheets.Add _ > > (after:=wb.Sheets(wb.Sheets.Count)) > > NewSh.Name = cell.Value > > For i = 0 To 5 > > NewSh.Range("a65000").End(xlUp).Offset(0, i).Value _ > > = cell.Offset(0, i + 1).Value > > Next i > > End If > > bExist = False > > Next cell > > End Sub > > HTH > >{*filter*} K.
> > > This is a sample of sheet of my work book > > > Sheet1 > > > 100 1 .375 .1875 ball mill 3000 rough top > > > 110 2 .625 0.0 end mill 3000 finish top > > > 120 3 .500 0.0 end mill 3000 final top cut > > > 120 3 .500 0.0 end mill 3000 cut 1 > > > 120 3 .500 0.0 end mill 3000 cut 2 > > > 130 4 1.25 0.0 end mill 5000 cut 1 > > > 130 4 1.25 0.0 end mill 5000 cut 2 > > > 140 8 1.5 0.0 end mill 8000 cut 1 > > > 140 8 1.5 0.0 end mill 8000 cut 2 > > > The following is the macro I am using to create blanks sheets > > > that are named the number of the value in the first columns > > > without duplicate. This works great > ------------------------------------------------------------------------ - > > -- > > > - > > > Sub makeSheets() > > > Dim rng As Range > > > Dim ws As Worksheet > > > Set rng = Sheets("Sheet1").Range("A1", Range("A1").End(xlDown)) > > > On Error GoTo skip > > > For Each cel In rng > > > On Error Resume Next > > > For Each ws In ThisWorkbook.Worksheets > > > If ws.Name = cel.Value Then > > > GoTo skip > > > End If > > > Next > > > Worksheets.Add.Name = cel.Value > > > skip: > > > Next > > > End Sub > ------------------------------------------------------------------------ - > > -- > > > - > > > But what I now need to do is copy some of this data onto those > > > sheets created by the same macro or a call to another macro, > > > again without duplicates > > > You may have multiple duplicate numbers in the first column > > > and if you do the next few columns also have the same data > > > but the last field has differing data. > > > So in this sheet creating loop I need to > > > Number one; > > > Create a blank sheet with that number as the name, then > > > copy the data from the next 4 columns to that sheet along > > > with the last cell. > > > Number two; > > > If there is another row that has the same number, we only want > > > to copy the last cell data to the sheet of that number. > > > Here are samples of what the additional sheets could look like. > > > ----------------------------------------------------------- > > > Sheet100 > > > 1 .375 .1875 ball mill 3000 rough top > > > ----------------------------------------------------------- > > > Sheet110 > > > 2 .625 0.0 end mill 3000 finish top > > > ----------------------------------------------------------- > > > Sheet120 > > > 3 .500 0.0 end mill 3000 final top cut > > > cut 1 > > > cut 2 > > > ----------------------------------------------------------- > > > Sheet130 > > > 4 1.25 0.0 end mill 5000 cut 1 > > > cut 2 > > > ----------------------------------------------------------- > > > Sheet140 > > > 8 1.5 0.0 end mill 8000 cut 1 > > > cut 2 > > > ----------------------------------------------------------- > > > This project has been on going for some time now and I think this is > the > > > last major improvement to be made, any help would certainly be > > > appreciated... > > > Thanks in advance > > > Jeff White
|
Mon, 15 Mar 2004 21:30:58 GMT |
|
 |
Jeff #5 / 7
|
 Request for help transfering data between sheets
Well, what I was thinking was, I may want to start all the data on the new sheets at "E14" or "D10". whatever it turns out being it will be the same for all these sheets that are created. Thanks Jeff White
Quote: > Jeff > This line determines where to start on a new sheet. > > > NewSh.Range("a65000").End(xlUp).Offset(0, i).Value _ > > > = cell.Offset(0, i + 1).Value > If you want to start in A2 instead of A1, change the first parameter of > Offset to 1. If you had something else in mind, post back and be specific. > HTH >{*filter*} K.
> >{*filter*}, This looks great, Do you have any suggestions > > on how I might be able to specify a starting position > > for the data on the newly created sheets? > > Jeff White
> > > Jeff > > > I changed your original sub a little because I hate GoTo's. But this > sub > > > seems to do what you want. > > > Sub MakeSheets() > > > Dim ws As Worksheet, Sh1 As Worksheet > > > Dim NewSh As Worksheet > > > Dim wb As Workbook > > > Dim bExist As Boolean > > > Dim cell As Range, Rng As Range > > > Dim i As Integer > > > Set wb = ThisWorkbook > > > Set Sh1 = ThisWorkbook.Sheets("Sheet1") > > > Set Rng = Sh1.Range("a1", Sh1.Range("a1").End(xlDown)) > > > bExist = False > > > For Each cell In Rng > > > For Each ws In wb.Worksheets > > > If ws.Name = cell.Value Then > > > bExist = True > > > End If > > > Next ws > > > If bExist Then > > > wb.Sheets(CStr(cell.Value)).Range("f65000").End(xlUp). _ > > > Offset(1, 0).Value = cell.Offset(0, 6).Value > > > Else > > > Set NewSh = wb.Worksheets.Add _ > > > (after:=wb.Sheets(wb.Sheets.Count)) > > > NewSh.Name = cell.Value > > > For i = 0 To 5 > > > NewSh.Range("a65000").End(xlUp).Offset(0, i).Value _ > > > = cell.Offset(0, i + 1).Value > > > Next i > > > End If > > > bExist = False > > > Next cell > > > End Sub > > > HTH > > >{*filter*} K.
> > > > This is a sample of sheet of my work book > > > > Sheet1 > > > > 100 1 .375 .1875 ball mill 3000 rough top > > > > 110 2 .625 0.0 end mill 3000 finish top > > > > 120 3 .500 0.0 end mill 3000 final top cut > > > > 120 3 .500 0.0 end mill 3000 cut 1 > > > > 120 3 .500 0.0 end mill 3000 cut 2 > > > > 130 4 1.25 0.0 end mill 5000 cut 1 > > > > 130 4 1.25 0.0 end mill 5000 cut 2 > > > > 140 8 1.5 0.0 end mill 8000 cut 1 > > > > 140 8 1.5 0.0 end mill 8000 cut 2 > > > > The following is the macro I am using to create blanks sheets > > > > that are named the number of the value in the first columns > > > > without duplicate. This works great
------------------------------------------------------------------------ Quote: > - > > > -- > > > > - > > > > Sub makeSheets() > > > > Dim rng As Range > > > > Dim ws As Worksheet > > > > Set rng = Sheets("Sheet1").Range("A1", Range("A1").End(xlDown)) > > > > On Error GoTo skip > > > > For Each cel In rng > > > > On Error Resume Next > > > > For Each ws In ThisWorkbook.Worksheets > > > > If ws.Name = cel.Value Then > > > > GoTo skip > > > > End If > > > > Next > > > > Worksheets.Add.Name = cel.Value > > > > skip: > > > > Next > > > > End Sub
------------------------------------------------------------------------ Quote: > - > > > -- > > > > - > > > > But what I now need to do is copy some of this data onto those > > > > sheets created by the same macro or a call to another macro, > > > > again without duplicates > > > > You may have multiple duplicate numbers in the first column > > > > and if you do the next few columns also have the same data > > > > but the last field has differing data. > > > > So in this sheet creating loop I need to > > > > Number one; > > > > Create a blank sheet with that number as the name, then > > > > copy the data from the next 4 columns to that sheet along > > > > with the last cell. > > > > Number two; > > > > If there is another row that has the same number, we only want > > > > to copy the last cell data to the sheet of that number. > > > > Here are samples of what the additional sheets could look like. > > > > ----------------------------------------------------------- > > > > Sheet100 > > > > 1 .375 .1875 ball mill 3000 rough top > > > > ----------------------------------------------------------- > > > > Sheet110 > > > > 2 .625 0.0 end mill 3000 finish top > > > > ----------------------------------------------------------- > > > > Sheet120 > > > > 3 .500 0.0 end mill 3000 final top cut > > > > cut 1 > > > > cut 2 > > > > ----------------------------------------------------------- > > > > Sheet130 > > > > 4 1.25 0.0 end mill 5000 cut 1 > > > > cut 2 > > > > ----------------------------------------------------------- > > > > Sheet140 > > > > 8 1.5 0.0 end mill 8000 cut 1 > > > > cut 2 > > > > ----------------------------------------------------------- > > > > This project has been on going for some time now and I think this is > > the > > > > last major improvement to be made, any help would certainly be > > > > appreciated... > > > > Thanks in advance > > > > Jeff White
|
Tue, 16 Mar 2004 09:52:34 GMT |
|
 |
Dick Kusleik #6 / 7
|
 Request for help transfering data between sheets
Jeff For E14: NewSh.Range("E14").Offset(0, i).Value _ = cell.Offset(0, i + 1).Value For D10 NewSh.Range("D10").Offset(0, i).Value _ = cell.Offset(0, i + 1).Value HTH {*filter*} K.
Quote: > Well, what I was thinking was, I may want to start > all the data on the new sheets at "E14" or "D10". > whatever it turns out being it will be the same for > all these sheets that are created. > Thanks > Jeff White
> > Jeff > > This line determines where to start on a new sheet. > > > > NewSh.Range("a65000").End(xlUp).Offset(0, i).Value _ > > > > = cell.Offset(0, i + 1).Value > > If you want to start in A2 instead of A1, change the first parameter of > > Offset to 1. If you had something else in mind, post back and be > specific. > > HTH > >{*filter*} K.
> > >{*filter*}, This looks great, Do you have any suggestions > > > on how I might be able to specify a starting position > > > for the data on the newly created sheets? > > > Jeff White
> > > > Jeff > > > > I changed your original sub a little because I hate GoTo's. But this > > sub > > > > seems to do what you want. > > > > Sub MakeSheets() > > > > Dim ws As Worksheet, Sh1 As Worksheet > > > > Dim NewSh As Worksheet > > > > Dim wb As Workbook > > > > Dim bExist As Boolean > > > > Dim cell As Range, Rng As Range > > > > Dim i As Integer > > > > Set wb = ThisWorkbook > > > > Set Sh1 = ThisWorkbook.Sheets("Sheet1") > > > > Set Rng = Sh1.Range("a1", Sh1.Range("a1").End(xlDown)) > > > > bExist = False > > > > For Each cell In Rng > > > > For Each ws In wb.Worksheets > > > > If ws.Name = cell.Value Then > > > > bExist = True > > > > End If > > > > Next ws > > > > If bExist Then > > > > wb.Sheets(CStr(cell.Value)).Range("f65000").End(xlUp). _ > > > > Offset(1, 0).Value = cell.Offset(0, 6).Value > > > > Else > > > > Set NewSh = wb.Worksheets.Add _ > > > > (after:=wb.Sheets(wb.Sheets.Count)) > > > > NewSh.Name = cell.Value > > > > For i = 0 To 5 > > > > NewSh.Range("a65000").End(xlUp).Offset(0, i).Value _ > > > > = cell.Offset(0, i + 1).Value > > > > Next i > > > > End If > > > > bExist = False > > > > Next cell > > > > End Sub > > > > HTH > > > >{*filter*} K.
> > > > > This is a sample of sheet of my work book > > > > > Sheet1 > > > > > 100 1 .375 .1875 ball mill 3000 rough top > > > > > 110 2 .625 0.0 end mill 3000 finish top > > > > > 120 3 .500 0.0 end mill 3000 final top cut > > > > > 120 3 .500 0.0 end mill 3000 cut 1 > > > > > 120 3 .500 0.0 end mill 3000 cut 2 > > > > > 130 4 1.25 0.0 end mill 5000 cut 1 > > > > > 130 4 1.25 0.0 end mill 5000 cut 2 > > > > > 140 8 1.5 0.0 end mill 8000 cut 1 > > > > > 140 8 1.5 0.0 end mill 8000 cut 2 > > > > > The following is the macro I am using to create blanks sheets > > > > > that are named the number of the value in the first columns > > > > > without duplicate. This works great > ------------------------------------------------------------------------ > > - > > > > -- > > > > > - > > > > > Sub makeSheets() > > > > > Dim rng As Range > > > > > Dim ws As Worksheet > > > > > Set rng = Sheets("Sheet1").Range("A1", Range("A1").End(xlDown)) > > > > > On Error GoTo skip > > > > > For Each cel In rng > > > > > On Error Resume Next > > > > > For Each ws In ThisWorkbook.Worksheets > > > > > If ws.Name = cel.Value Then > > > > > GoTo skip > > > > > End If > > > > > Next > > > > > Worksheets.Add.Name = cel.Value > > > > > skip: > > > > > Next > > > > > End Sub > ------------------------------------------------------------------------ > > - > > > > -- > > > > > - > > > > > But what I now need to do is copy some of this data onto those > > > > > sheets created by the same macro or a call to another macro, > > > > > again without duplicates > > > > > You may have multiple duplicate numbers in the first column > > > > > and if you do the next few columns also have the same data > > > > > but the last field has differing data. > > > > > So in this sheet creating loop I need to > > > > > Number one; > > > > > Create a blank sheet with that number as the name, then > > > > > copy the data from the next 4 columns to that sheet along > > > > > with the last cell. > > > > > Number two; > > > > > If there is another row that has the same number, we only want > > > > > to copy the last cell data to the sheet of that number. > > > > > Here are samples of what the additional sheets could look like. > > > > > ----------------------------------------------------------- > > > > > Sheet100 > > > > > 1 .375 .1875 ball mill 3000 rough top > > > > > ----------------------------------------------------------- > > > > > Sheet110 > > > > > 2 .625 0.0 end mill 3000 finish top > > > > > ----------------------------------------------------------- > > > > > Sheet120 > > > > > 3 .500 0.0 end mill 3000 final top cut > > > > > cut 1 > > > > > cut 2 > > > > > ----------------------------------------------------------- > > > > > Sheet130 > > > > > 4 1.25 0.0 end mill 5000 cut 1 > > > > > cut 2 > > > > > ----------------------------------------------------------- > > > > > Sheet140 > > > > > 8 1.5 0.0 end mill 8000 cut 1 > > > > > cut 2 > > > > > ----------------------------------------------------------- > > > > > This project has been on going for some time now and I think this > is > > > the > > > > > last major improvement to be made, any help would certainly be > > > > > appreciated... > > > > > Thanks in advance > > > > > Jeff White
|
Tue, 16 Mar 2004 20:29:03 GMT |
|
 |
Jeff #7 / 7
|
 Request for help transfering data between sheets
Thanks{*filter*}, This is very good help I appreciate you efforts... Jeff White
Quote: > Jeff > For E14: > NewSh.Range("E14").Offset(0, i).Value _ > = cell.Offset(0, i + 1).Value > For D10 > NewSh.Range("D10").Offset(0, i).Value _ > = cell.Offset(0, i + 1).Value > HTH >{*filter*} K.
> > Well, what I was thinking was, I may want to start > > all the data on the new sheets at "E14" or "D10". > > whatever it turns out being it will be the same for > > all these sheets that are created. > > Thanks > > Jeff White
> > > Jeff > > > This line determines where to start on a new sheet. > > > > > NewSh.Range("a65000").End(xlUp).Offset(0, i).Value _ > > > > > = cell.Offset(0, i + 1).Value > > > If you want to start in A2 instead of A1, change the first parameter of > > > Offset to 1. If you had something else in mind, post back and be > > specific. > > > HTH > > >{*filter*} K.
> > > >{*filter*}, This looks great, Do you have any suggestions > > > > on how I might be able to specify a starting position > > > > for the data on the newly created sheets? > > > > Jeff White
> > > > > Jeff > > > > > I changed your original sub a little because I hate GoTo's. But > this > > > sub > > > > > seems to do what you want. > > > > > Sub MakeSheets() > > > > > Dim ws As Worksheet, Sh1 As Worksheet > > > > > Dim NewSh As Worksheet > > > > > Dim wb As Workbook > > > > > Dim bExist As Boolean > > > > > Dim cell As Range, Rng As Range > > > > > Dim i As Integer > > > > > Set wb = ThisWorkbook > > > > > Set Sh1 = ThisWorkbook.Sheets("Sheet1") > > > > > Set Rng = Sh1.Range("a1", Sh1.Range("a1").End(xlDown)) > > > > > bExist = False > > > > > For Each cell In Rng > > > > > For Each ws In wb.Worksheets > > > > > If ws.Name = cell.Value Then > > > > > bExist = True > > > > > End If > > > > > Next ws > > > > > If bExist Then > > > > > wb.Sheets(CStr(cell.Value)).Range("f65000").End(xlUp). _ > > > > > Offset(1, 0).Value = cell.Offset(0, 6).Value > > > > > Else > > > > > Set NewSh = wb.Worksheets.Add _ > > > > > (after:=wb.Sheets(wb.Sheets.Count)) > > > > > NewSh.Name = cell.Value > > > > > For i = 0 To 5 > > > > > NewSh.Range("a65000").End(xlUp).Offset(0, i).Value _ > > > > > = cell.Offset(0, i + 1).Value > > > > > Next i > > > > > End If > > > > > bExist = False > > > > > Next cell > > > > > End Sub > > > > > HTH > > > > >{*filter*} K.
> > > > > > This is a sample of sheet of my work book > > > > > > Sheet1 > > > > > > 100 1 .375 .1875 ball mill 3000 rough top > > > > > > 110 2 .625 0.0 end mill 3000 finish top > > > > > > 120 3 .500 0.0 end mill 3000 final top cut > > > > > > 120 3 .500 0.0 end mill 3000 cut 1 > > > > > > 120 3 .500 0.0 end mill 3000 cut 2 > > > > > > 130 4 1.25 0.0 end mill 5000 cut 1 > > > > > > 130 4 1.25 0.0 end mill 5000 cut 2 > > > > > > 140 8 1.5 0.0 end mill 8000 cut 1 > > > > > > 140 8 1.5 0.0 end mill 8000 cut 2 > > > > > > The following is the macro I am using to create blanks sheets > > > > > > that are named the number of the value in the first columns > > > > > > without duplicate. This works great
------------------------------------------------------------------------ Quote: > > > - > > > > > -- > > > > > > - > > > > > > Sub makeSheets() > > > > > > Dim rng As Range > > > > > > Dim ws As Worksheet > > > > > > Set rng = Sheets("Sheet1").Range("A1", Range("A1").End(xlDown)) > > > > > > On Error GoTo skip > > > > > > For Each cel In rng > > > > > > On Error Resume Next > > > > > > For Each ws In ThisWorkbook.Worksheets > > > > > > If ws.Name = cel.Value Then > > > > > > GoTo skip > > > > > > End If > > > > > > Next > > > > > > Worksheets.Add.Name = cel.Value > > > > > > skip: > > > > > > Next > > > > > > End Sub
------------------------------------------------------------------------ Quote: > > > - > > > > > -- > > > > > > - > > > > > > But what I now need to do is copy some of this data onto those > > > > > > sheets created by the same macro or a call to another macro, > > > > > > again without duplicates > > > > > > You may have multiple duplicate numbers in the first column > > > > > > and if you do the next few columns also have the same data > > > > > > but the last field has differing data. > > > > > > So in this sheet creating loop I need to > > > > > > Number one; > > > > > > Create a blank sheet with that number as the name, then > > > > > > copy the data from the next 4 columns to that sheet along > > > > > > with the last cell. > > > > > > Number two; > > > > > > If there is another row that has the same number, we only want > > > > > > to copy the last cell data to the sheet of that number. > > > > > > Here are samples of what the additional sheets could look like. > > > > > > ----------------------------------------------------------- > > > > > > Sheet100 > > > > > > 1 .375 .1875 ball mill 3000 rough top > > > > > > ----------------------------------------------------------- > > > > > > Sheet110 > > > > > > 2 .625 0.0 end mill 3000 finish top > > > > > > ----------------------------------------------------------- > > > > > > Sheet120 > > > > > > 3 .500 0.0 end mill 3000 final top cut > > > > > > cut 1 > > > > > > cut 2 > > > > > > ----------------------------------------------------------- > > > > > > Sheet130 > > > > > > 4 1.25 0.0 end mill 5000 cut 1 cut > 2 > > > > > > ----------------------------------------------------------- > > > > > > Sheet140 > > > > > > 8 1.5 0.0 end mill 8000 cut 1 cut > 2 > > > > > > ----------------------------------------------------------- > > > > > > This project has been on going for some time now and I think this > > is > > > > the > > > > > > last major improvement to be made, any help would certainly be > > > > > > appreciated... > > > > > > Thanks in advance > > > > > > Jeff White
|
Wed, 17 Mar 2004 00:50:43 GMT |
|
|
|