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 |
|
| |
|
