• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Creating new sheet using Template

sridhar_shri03

New Member
Hi,

Greetings for the day !!!

I am trying create sheets using template based on unique value and I want those datas to be pasted in respective sheets

Now I got some code which is creating sheets perfectly but I want to create sheet using template and I want the data should be pasted in range a20 in each sheets

upload_2013-12-10_17-57-13.png

I am attaching the File and template(inside the file "Template" sheet)which I am using currently for this purpose.

code which I am using currently:

Sub PagesByDescription()
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String

Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
'Set a range variable to the correct item column
Set rRange = Range("A1", Range("A65536").End(xlUp))

'Delete any sheet called "UniqueList"
'Turn off run time errors & delete alert
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("UniqueList").Delete

'Add a sheet called "UniqueList"
Worksheets.Add().Name = "UniqueList"

'Filter the Set range so only a unique list is created
With Worksheets("UniqueList")
rRange.AdvancedFilter xlFilterCopy, , _
Worksheets("UniqueList").Range("A1"), True

'Set a range variable to the unique list, less the heading.
Set rRange = .Range("A2", .Range("A65536").End(xlUp))
End With

On Error Resume Next
With wSheetStart
For Each rCell In rRange
strText = rCell
.Range("A1").AutoFilter 1, strText
Worksheets(strText).Delete
'Add a sheet named as content of rCell
Worksheets.Add().Name = strText
'Copy the visible filtered range _
(default of Copy Method) and leave hidden rows
.UsedRange.Copy Destination:=ActiveSheet.Range("A1")
ActiveSheet.Cells.Columns.AutoFit
Next rCell
End With

With wSheetStart
.AutoFilterMode = False
.Activate
End With

On Error GoTo 0
Application.DisplayAlerts = True
End Sub

Please help
 

Attachments

  • Hawleys Brewery Workbook.xls
    67 KB · Views: 7
Hi, sridhar_shri03!
I'd go for the AdvancedFilter method. Tried yet using the built-in search at right top of this window? There should be many similar cases since this is a question frequently posed.
Regards!
 
Hi SirJB7

Thanks for your response

I am very new to this site ... i tried searching it but not able to find it.

It would be better if you could help me on this issue

Thanks
 
Hi sridhar

change this line:

.UsedRange.Copy Destination:=ActiveSheet.Range("A1")

to

.UsedRange.Copy Destination:=ActiveSheet.Range("A20")

kanti
 
Back
Top