Search code examples
vbaexcelloopsworksheet

Need help on Excel VBA loop code that creates new worksheets using cells in range


My code below attempts to create a worksheet for each cell value in Column D and then do work in each worksheet 1 at a time (i.e., paste values and run 2 formulas). It errors out on the selection.copy command and the activesheet.name command.

I am looking to create 1 worksheet at a time, run formulas in that worksheet, and repeat instead of adding all of the worksheets at once and then renaming them using the cell values in column D.

I apologize in advance for the lengthiness, I'm a VBA beginner and most of this code came from using the record function.

Sub Macro2()

Dim x As Integer
NumRows = Range("D1", Range("D1").End(xlDown)).Rows.Count
Range("D1").Select
For x = 1 To NumRows


Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Select
ActiveSheet.Name = Selection.Paste
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Sheet1").Select
Range("H2:H5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(Selection.Paste).Select
Range("A2").Select
ActiveSheet.Paste
Range("A5").Select
Application.CutCopyMode = False
Range("B6").Select
ActiveCell.FormulaR1C1 = "=BDH(R[-5]C[-1],R[-2]C[-1],R[-4]C[-1],R[-3]C[-1],)"
Range("D6").Select
ActiveCell.FormulaR1C1 = "=BDH(R[-5]C[-3],R[-1]C[-3],R[-4]C[-3],R[-3]C[-3],)"
Range("D6").Select
Sheets(Selection.Paste).Select

Next

End Sub

Sheet1

Thanks in advance!


Solution

  • Whatever that “BDH” in your formula may be, you may try this:

    Sub Macro2()
        Dim valuesRng As Range, hRng As Range, cell As Range
    
        With Sheet1
            Set valuesRng = .Range("D1", .Range("D1").End(xlDown))
            Set hRng = .Range("H2:H5")
        End with
    
        For Each cell in valuesRng
            With Sheets.Add(After:=Sheets(Sheets.Count))
                .Name = cell.Value
                .Range("A1").Value= cell.Value
                .Range("A2:A5").Value= hRng.Value
                .Range("B6").FormulaR1C1 = "=BDH(R[-5]C[-1],R[-2]C[-1],R[-4]C[-1],R[-3]C[-1],)"
                .Range("D6").FormulaR1C1 = "=BDH(R[-5]C[-3],R[-1]C[-3],R[-4]C[-3],R[-3]C[-3],)"
            End with
        Next
    End Sub