Macro to copy sheet from list error

Question

I have created a macro to create worksheets from a list,this works fine but i have a problem, if i only have one item in the list i get an error, here is the macro:

Sub CreateSheetsFromAList()
Application.ScreenUpdating = False
Sheets("Master").Select
Sheets("Stock Removal").Visible = True

Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("Master").Range("A14")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

For Each MyCell In MyRange
    Sheets("Stock Removal").Copy after:=Sheets(Sheets.Count) 'creates a new worksheet
    Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
Next MyCell
Sheets("Stock Removal").Select
ActiveWindow.SelectedSheets.Visible = False
Application.ScreenUpdating = True
End Sub

Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet — Maxe1984, Jan 23 '17 at 12:12
Once the error comes up i have pressed end and It continues to create the sheet but also creates a copy of the original sheet it has used as a template with a (2) at the end. e.g. Stock Removal (2) — Maxe1984, Jan 23 '17 at 12:15
it's because you already ran this code and created these sheets, so Excel is not overwriting these sheets (from previous runs) but creates another with (2) — Shai Rado, Jan 23 '17 at 12:24

score 0 · Accepted Answer · answered Jan 23 '17 at 12:17

You should rather use xlUp than xlDown, it is safer!

You selected the whole column previously (from row 14, until the end of the sheet!)

This will run smoothly! ;)

Sub CreateSheetsFromAList()
Application.ScreenUpdating = False
Dim wsM As Worksheet, wsSR As Worksheet
Dim MyCell As Range, MyRange As Range, LastRow As Double
Set wsM = ThisWorkbook.Sheets("Master")
Set wsSR = ThisWorkbook.Sheets("Stock Removal")
wsM.Select
wsSR.Visible = True

Set MyRange = wsM.Range("A14")
LastRow = wsM.Range("A" & wsM.Rows.Count).End(xlUp).Row
If LastRow > 14 Then
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    For Each MyCell In MyRange
        wsSR.Copy after:=Sheets(Sheets.Count) 'creates a new worksheet
        Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
    Next MyCell
Else
    wsSR.Copy after:=Sheets(Sheets.Count) 'creates a new worksheet
    Sheets(Sheets.Count).Name = MyRange.Value ' renames the new worksheet
End If

wsSR.Select
ActiveWindow.SelectedSheets.Visible = False
Application.ScreenUpdating = True
End Sub

@Maxe1984 : You are welcome, btw take a look at this : http://stackoverflow.com/a/11169920/4628637 — R3uK, Jan 23 '17 at 13:03

score 0 · Answer 2 · answered Jan 23 '17 at 12:18

The problem is in case if only Cell A14 has data, and the entire column A (below cell A14) is blank, in that case MyRange.End(xlDown) will result in "A1048576". So you need to find the last row in Column A, and then check if it's 14 >> If it is then your MyRange should consist of 1 cell, and that's Cell A14.

Try the code below to replace the way you Set MyRange :

With Sheets("Master")
    If .Cells(.Rows.Count, "A").End(xlUp).Row = 14 Then ' if only cell A14 has data in entire Column A
        Set MyRange = Sheets("Master").Range("A14")
    Else
        Set MyRange = Sheets("Master").Range("A14", Range("A14").End(xlDown))
    End If
End With

@Maxe1984 replace your 2 lines of Set MyRange with this code — Shai Rado, Jan 23 '17 at 12:26

score 0 · Answer 3 · answered Jan 23 '17 at 12:22

0

Try with changing:

Set MyRange = Sheets("Master").Range("A14")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

To:

With Sheets("Master")
    Set MyRange = .Range(Range("A14"), .Range("A" & .Range("A" & .Rows.Count).End(xlUp).row))
End With

answered Jan 23 '17 at 12:22

Limak

1,511
3
12
22

Macro to copy sheet from list error

3 Answers3