Copy/Pasting a Sheet multiple times in the same work book

[Morallach]

Hi Everybody!

I'm trying to copy and paste a single sheet multiple times in the same workbook. I've got some code based on the record macro feature and some help which I'm very grateful for through the forums so far but its not quite doing what I need it to.


What the Macro is doing is good for the first copy (copying sheet1 and creating sheet2 exactly). When I run the macro again it creates sheet3 but copies in sheet2. I think I can see why (the command is telling it to paste in the active sheet) however I don't know how to change that.

What I would like the macro to do eventually is to run when a value is put in cell AH1 of Airborne Fibre Estimation, copy the Sheet1 and paste (based on the column widths) up to the half the value of cell AH1 on Airborne Fibre Estimation, rounded up to next even number.

The Macro

Sub AFE_Dup()
'
' AFE_Dup Macro
' Duplicate AFE Sheet1 format and formulas based on thevalue in cell AH1
'
' Keyboard Shortcut: Ctrl+d
'
    Cells.Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Application.CutCopyMode = False
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.31496062992126)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0.236220472440945)
        .BottomMargin = Application.InchesToPoints(0.236220472440945)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.196850393700787)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    ActiveWindow.View = xlPageLayoutView
    Sheets("Sheet1").Select
    Cells.Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
End Sub

If there is a solution you're willing to share that would be fantastic

[davesexcel]

Cells.Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Application.CutCopyMode = False

You selected cells and copied, then added a worksheet. Then you turned CutCopy to false, so there is no longer anything to paste.
You obviously want to copy the entire sheet to a new sheet, what was wrong with the code I gave you in your previous post?