Hi Everybody,

I would like VBA Code that is Similar to the One Below ( but Not
Adapting the One Below, I Still want to Use it as it is ) which Works a
Treat ...

Code:
Sub SheetInsert()
Dim s1 As String, s2 As String
Dim x As Long, y As Long, i As Long
Dim pasteto As String
Application.ScreenUpdating = False

s1 = "How many sheets would you like to add?"
s2 = "What would you like the number of the first sheet to be?"
x = InputBox(s1)
y = InputBox(s2, "Insert Sheets")

For i = 1 To x
Sheets.Add After:=Sheets(Sheets.Count)
pasteto = i + y - 1
ActiveSheet.Name = pasteto
With Sheets(pasteto)
Sheets("Master").Cells.Copy _
Destination:=.Range("A1")
.Range("A1").Value = .Name
.Range("B22").Select
End With
Next i

Application.ScreenUpdating = True
End Sub

.... to Ask me in the First Box which Sheet to Start with, and the
Second Box to Ask me which Sheet to End with ( the Sheets are Numbered
1 to Whatever for Example ).
I then want Each of those Sheets to be Highlighted in the Top Left Hand
Corner so it Selects ALL of the Sheet, and for ALL of the Sheets
Specified. I then want to Copy and Paste Special Using Values.
And Finally, I would like the Cursor to End Up in Cell B22 of EVERY
Sheet Please.

Thanks in Advance.
All the Best.
Paul

This does it...
..
Sub SheetCopyValues()
Dim s1 As String, s2 As String
Dim x As Long, y As Long, i As Long
Dim pasteto As String
Application.ScreenUpdating = False

s1 = "Enter number of first sheet"
s2 = "Enter number of last sheet"
x = InputBox(s1, "First Sheet to copy to")
y = InputBox(s2, "Last Sheet to copy to")

For i = x To y
Sheets("Master").Cells.Copy
On Error Resume Next
With Sheets(CStr(i))
.Activate
.Range("A1").PasteSpecial Paste:=xlPasteValues
.Range("A1") = .Name
.Range("B22").Select
End With
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub



--
Cheers
Nigel



"Paul Black" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> Hi Everybody,
>
> I would like VBA Code that is Similar to the One Below ( but Not
> Adapting the One Below, I Still want to Use it as it is ) which Works a
> Treat ...
>
> Code:
> Sub SheetInsert()
> Dim s1 As String, s2 As String
> Dim x As Long, y As Long, i As Long
> Dim pasteto As String
> Application.ScreenUpdating = False
>
> s1 = "How many sheets would you like to add?"
> s2 = "What would you like the number of the first sheet to be?"
> x = InputBox(s1)
> y = InputBox(s2, "Insert Sheets")
>
> For i = 1 To x
> Sheets.Add After:=Sheets(Sheets.Count)
> pasteto = i + y - 1
> ActiveSheet.Name = pasteto
> With Sheets(pasteto)
> Sheets("Master").Cells.Copy _
> Destination:=.Range("A1")
> .Range("A1").Value = .Name
> .Range("B22").Select
> End With
> Next i
>
> Application.ScreenUpdating = True
> End Sub
>
> ... to Ask me in the First Box which Sheet to Start with, and the
> Second Box to Ask me which Sheet to End with ( the Sheets are Numbered
> 1 to Whatever for Example ).
> I then want Each of those Sheets to be Highlighted in the Top Left Hand
> Corner so it Selects ALL of the Sheet, and for ALL of the Sheets
> Specified. I then want to Copy and Paste Special Using Values.
> And Finally, I would like the Cursor to End Up in Cell B22 of EVERY
> Sheet Please.
>
> Thanks in Advance.
> All the Best.
> Paul
>

Hi Nigel,

Thanks for the Reply.
What my Original Macro does is Copy x Number of the Sheet Named
"Master" and Insert them After the Sheet Number I put in Box 1 Until it
Reaches the Sheet Number I put in Box 2.
This is OK but you can Appreciate that After Several Hundred Inserts of
Sheets the File Size gets Quite Big Because of All the Formulas.
Ideally the New Macro will go from the Sheet Number I Specify in Box 1
Until the Sheet Number I Specify in Box 2, and Transfer All the
Formulas to Values and Leave the Cursor on Cell B22.
My Appologies for Not Explaining Myself Clearly Enough in my Original
Post.

Thanks in Advance.
All the Best.
Paul

Nigel wrote:
> This does it...
> .
> Sub SheetCopyValues()
> Dim s1 As String, s2 As String
> Dim x As Long, y As Long, i As Long
> Dim pasteto As String
> Application.ScreenUpdating = False
>
> s1 = "Enter number of first sheet"
> s2 = "Enter number of last sheet"
> x = InputBox(s1, "First Sheet to copy to")
> y = InputBox(s2, "Last Sheet to copy to")
>
> For i = x To y
> Sheets("Master").Cells.Copy
> On Error Resume Next
> With Sheets(CStr(i))
> .Activate
> .Range("A1").PasteSpecial Paste:=xlPasteValues
> .Range("A1") = .Name
> .Range("B22").Select
> End With
> Next i
> Application.CutCopyMode = False
> Application.ScreenUpdating = True
> End Sub
>
>
>
> --
> Cheers
> Nigel
>
>
>
> "Paul Black" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
> > Hi Everybody,
> >
> > I would like VBA Code that is Similar to the One Below ( but Not
> > Adapting the One Below, I Still want to Use it as it is ) which Works a
> > Treat ...
> >
> > Code:
> > Sub SheetInsert()
> > Dim s1 As String, s2 As String
> > Dim x As Long, y As Long, i As Long
> > Dim pasteto As String
> > Application.ScreenUpdating = False
> >
> > s1 = "How many sheets would you like to add?"
> > s2 = "What would you like the number of the first sheet to be?"
> > x = InputBox(s1)
> > y = InputBox(s2, "Insert Sheets")
> >
> > For i = 1 To x
> > Sheets.Add After:=Sheets(Sheets.Count)
> > pasteto = i + y - 1
> > ActiveSheet.Name = pasteto
> > With Sheets(pasteto)
> > Sheets("Master").Cells.Copy _
> > Destination:=.Range("A1")
> > .Range("A1").Value = .Name
> > .Range("B22").Select
> > End With
> > Next i
> >
> > Application.ScreenUpdating = True
> > End Sub
> >
> > ... to Ask me in the First Box which Sheet to Start with, and the
> > Second Box to Ask me which Sheet to End with ( the Sheets are Numbered
> > 1 to Whatever for Example ).
> > I then want Each of those Sheets to be Highlighted in the Top Left Hand
> > Corner so it Selects ALL of the Sheet, and for ALL of the Sheets
> > Specified. I then want to Copy and Paste Special Using Values.
> > And Finally, I would like the Cursor to End Up in Cell B22 of EVERY
> > Sheet Please.
> >
> > Thanks in Advance.
> > All the Best.
> > Paul
> >

Minor changes required -- see below

Sub SheetCopyValues()
Dim s1 As String, s2 As String
Dim x As Long, y As Long, i As Long

Application.ScreenUpdating = False
s1 = "Enter number of first sheet"
s2 = "Enter number of last sheet"
x = InputBox(s1, "First Sheet to copy to")
y = InputBox(s2, "Last Sheet to copy to")

For i = x To y
On Error Resume Next
With Sheets(CStr(i))
.Activate
.Cells.Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues
.Range("A1") = .Name
Application.CutCopyMode = False
.Range("B22").Select
End With
Next i

Application.ScreenUpdating = True
End Sub

--
Cheers
Nigel



"Paul Black" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> Hi Nigel,
>
> Thanks for the Reply.
> What my Original Macro does is Copy x Number of the Sheet Named
> "Master" and Insert them After the Sheet Number I put in Box 1 Until it
> Reaches the Sheet Number I put in Box 2.
> This is OK but you can Appreciate that After Several Hundred Inserts of
> Sheets the File Size gets Quite Big Because of All the Formulas.
> Ideally the New Macro will go from the Sheet Number I Specify in Box 1
> Until the Sheet Number I Specify in Box 2, and Transfer All the
> Formulas to Values and Leave the Cursor on Cell B22.
> My Appologies for Not Explaining Myself Clearly Enough in my Original
> Post.
>
> Thanks in Advance.
> All the Best.
> Paul
>
> Nigel wrote:
>> This does it...
>> .
>> Sub SheetCopyValues()
>> Dim s1 As String, s2 As String
>> Dim x As Long, y As Long, i As Long
>> Dim pasteto As String
>> Application.ScreenUpdating = False
>>
>> s1 = "Enter number of first sheet"
>> s2 = "Enter number of last sheet"
>> x = InputBox(s1, "First Sheet to copy to")
>> y = InputBox(s2, "Last Sheet to copy to")
>>
>> For i = x To y
>> Sheets("Master").Cells.Copy
>> On Error Resume Next
>> With Sheets(CStr(i))
>> .Activate
>> .Range("A1").PasteSpecial Paste:=xlPasteValues
>> .Range("A1") = .Name
>> .Range("B22").Select
>> End With
>> Next i
>> Application.CutCopyMode = False
>> Application.ScreenUpdating = True
>> End Sub
>>
>>
>>
>> --
>> Cheers
>> Nigel
>>
>>
>>
>> "Paul Black" <(E-Mail Removed)> wrote in message
>> news:(E-Mail Removed)...
>> > Hi Everybody,
>> >
>> > I would like VBA Code that is Similar to the One Below ( but Not
>> > Adapting the One Below, I Still want to Use it as it is ) which Works a
>> > Treat ...
>> >
>> > Code:
>> > Sub SheetInsert()
>> > Dim s1 As String, s2 As String
>> > Dim x As Long, y As Long, i As Long
>> > Dim pasteto As String
>> > Application.ScreenUpdating = False
>> >
>> > s1 = "How many sheets would you like to add?"
>> > s2 = "What would you like the number of the first sheet to be?"
>> > x = InputBox(s1)
>> > y = InputBox(s2, "Insert Sheets")
>> >
>> > For i = 1 To x
>> > Sheets.Add After:=Sheets(Sheets.Count)
>> > pasteto = i + y - 1
>> > ActiveSheet.Name = pasteto
>> > With Sheets(pasteto)
>> > Sheets("Master").Cells.Copy _
>> > Destination:=.Range("A1")
>> > .Range("A1").Value = .Name
>> > .Range("B22").Select
>> > End With
>> > Next i
>> >
>> > Application.ScreenUpdating = True
>> > End Sub
>> >
>> > ... to Ask me in the First Box which Sheet to Start with, and the
>> > Second Box to Ask me which Sheet to End with ( the Sheets are Numbered
>> > 1 to Whatever for Example ).
>> > I then want Each of those Sheets to be Highlighted in the Top Left Hand
>> > Corner so it Selects ALL of the Sheet, and for ALL of the Sheets
>> > Specified. I then want to Copy and Paste Special Using Values.
>> > And Finally, I would like the Cursor to End Up in Cell B22 of EVERY
>> > Sheet Please.
>> >
>> > Thanks in Advance.
>> > All the Best.
>> > Paul
>> >
>

Thanks for the Reply Nigel.

Your Code Works Great if there are NO Merged Cells in Any of the Sheets.
Unfortunately I have Several Merged Cells in Each of the Sheets.

Thanks in Advance.
All the Best.
Paul



*** Sent via Developersdex http://www.developersdex.com ***

Unmerge them first, they are not a good idea anyway!

--
Cheers
Nigel



"Paul Black" <(E-Mail Removed)> wrote in message
news:O$(E-Mail Removed)...
> Thanks for the Reply Nigel.
>
> Your Code Works Great if there are NO Merged Cells in Any of the Sheets.
> Unfortunately I have Several Merged Cells in Each of the Sheets.
>
> Thanks in Advance.
> All the Best.
> Paul
>
>
>
> *** Sent via Developersdex http://www.developersdex.com ***