VBA Issue - Stuggling Mightly

[kingewing]

Hello,
I have written the following code which creates a variable # of additional sheets in my workbook based on how many rows have names in them on my "Master" sheet column B. This macro also copies the various names in Column B on the Master and pastes it in cell A7 on the additional sheets. The last step I am having problems with is to also copy the following cells from the Master sheet to the newly created sheets based on the data in each row:
Master: C7, E7, F7, J7, R7, S7, U7, V7, W7, X7, Y7, AA7
Created Sheets: A62, D21, D29, D23, D25, D36, I21, I29, I23, I25, I36, D45

Sub CreateAddtlSheets()
Dim ListSh As Worksheet, BaseSh As Worksheet
Dim NewSh As Worksheet
Dim ListOfNames As Range, LRow As Long, Cell As Range
With ThisWorkbook
Set ListSh = .Sheets("Master")
Set BaseSh = .Sheets("Stmt")
End With
LRow = ListSh.Cells(Rows.Count, "B").End(xlUp).Row
Set ListOfNames = ListSh.Range("B7:B" & LRow)
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
For Each Cell In ListOfNames
BaseSh.Copy After:=Sheets(Sheets.Count)
Set NewSh = ActiveSheet
With NewSh
On Error GoTo 0
.Range("A7") = Cell.Value
.Calculate
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
End With
Next Cell
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
BaseSh.Activate '--Select Base.
Sheets("Setup").Select
End Sub

Any thoughts are greatly appreciated.

 

[CastroTheCat]

So this is the clumsiest, but probably easiest way to do it:

Create a bunch of variables that store the values in the (very random looking) selection of cells you have picked

Dim strOne, strTwo, strThree... as string

(These might be integers, of course)

At the opening of the macro, you would populate each of these:

strOne = Range("C7").Value

Then for each new sheet, use the variables to populate the cells

.range("A62").value = strOne
.range("D21").value = strTwo


I'm going to be lazy and not put them all in, but the amended code (my additions in red) would look like:

Sub CreateAddtlSheets()
Dim ListSh As Worksheet, BaseSh As Worksheet
Dim strOne, strTwo, strThree, strFour, strFive, strSix, strSeven, strEight, strNine, strTen, strEleven, strTwelve as String
Dim NewSh As Worksheet
Dim ListOfNames As Range, LRow As Long, Cell As Range
With ThisWorkbook
Set ListSh = .Sheets("Master")
Set BaseSh = .Sheets("Stmt")
End With
LRow = ListSh.Cells(Rows.Count, "B").End(xlUp).Row
Set ListOfNames = ListSh.Range("B7:B" & LRow)
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
strOne = Range("C7").Value
'etc etc
For Each Cell In ListOfNames
BaseSh.Copy After:=Sheets(Sheets.Count)
Set NewSh = ActiveSheet
With NewSh
On Error GoTo 0
.Range("A7") = Cell.Value
.Range("A62").Value = strOne
' etc etc
.Calculate
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
End With
Next Cell
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
BaseSh.Activate '--Select Base.
Sheets("Setup").Select
End Sub