Copy successive data in a column to successive sheets

[ChaosPup]

Hi everyone, I've written a macro to create a user defined number of new worksheets. What I'd like to do next is to have it copy successive entries in a column (I'm starting at F8) into the I3 cell in successive new sheets (i.e., contents of F8 to I3 in first new sheet, contents of F9 to I3 in second new sheet and so on). The number of entries in the column is variable but will always match the number of sheets, and can consist of numbers, letters and symbols. I've tried a few things, but all I can manage so far is getting it to put F8 in I3 of every sheet rather than working down the column. I've put my code below - any help greatly appreciated!!

Sub COPYFAT()

Application.DisplayAlerts = False   'Turns OFF error reporting overwrites file without prompting
Application.ScreenUpdating = False
   
   'Varible declarations
   
    Dim UnitNum As Variant      'Number of units
    Dim SheetName As Variant    'Name of sheet
    Dim TagNum As Variant
    Dim I As Integer            'Counter
    Dim Start As Integer        'First SN
    Dim Increment As Integer    'SN+1
    Dim xNumber As Integer
    Dim xName As String
    Dim xActiveSheet As Worksheet
    
    Start = Sheets("Control").Range("B10")
    UnitNum = Sheets("Control").Range("B9").Value - 1         'Number of units pulled from CELL B23 on control sheet ***-1 because index starts at ZERO***
    Worksheets(Range("B8").Value).Activate                    'Name of Sheet to copy from CELL B8 on control sheet
    Set xActiveSheet = ActiveSheet
            
    For I = 0 To UnitNum                                      'Planning to add this number to cell reference for name starts at zero so initial reference is correct
        Increment = Start + I
        TagNum = Sheets("Control").Range("F8")
        xName = ActiveSheet.Name
        xActiveSheet.Copy After:=ActiveWorkbook.Sheets(xName)
        ActiveSheet.Name = Sheets("Control").Range("B12") & "-" & Increment
        ActiveSheet.Range("A1") = Sheets("Control").Range("B12") & " Factory Acceptance Test Report"
        ActiveSheet.Range("I4") = Sheets("Control").Range("B8") & "-" & Increment
        ActiveSheet.Range("I2") = Sheets("Control").Range("B12")
        ActiveSheet.Range("I5") = Sheets("Control").Range("B13")
        ActiveSheet.Range("I6") = Sheets("Control").Range("B14")
        ActiveSheet.Range("I7") = Sheets("Control").Range("B15")
        ActiveSheet.Range("J10") = Sheets("Control").Range("B17")
        ActiveSheet.Range("J12") = Sheets("Control").Range("B18")
        ActiveSheet.Range("N14") = Sheets("Control").Range("B19")
        ActiveSheet.Range("O32") = Sheets("Control").Range("B20")
        ActiveSheet.Range("D41") = Sheets("Control").Range("B21")
        ActiveSheet.Range("D43") = Sheets("Control").Range("B15")
        ActiveSheet.Range("I3") = TagNum
    Next
    xActiveSheet.Activate
    
    Sheets("CONTROL").Activate
    
Application.DisplayAlerts = True                              'Turns ON error reporting
Application.ScreenUpdating = True

End Sub

 

[Fluff]

Try

TagNum = Sheets("Control").Range("F8").Offset(I)

 

[DanteAmor]

Try this:

Sub COPYFAT_2()
  Dim i As Long, Start As Long, UnitNum As Long, Increment As Long
  Dim shC As Worksheet, shT As Worksheet, shN As Worksheet
  Dim xName As String

  Application.DisplayAlerts = False       'Turns OFF error reporting overwrites file without prompting
  Application.ScreenUpdating = False
  
  Set shC = Sheets("Control")
  Set shT = Sheets(shC.Range("B8").Value) 'Name of Sheet to copy from CELL B8 on control sheet
  Start = shC.Range("B10").Value          'start
  UnitNum = shC.Range("B9").Value         'Number of units pulled on control sheet
  xName = shT.Name
        
  For i = 1 To UnitNum                    'Planning to add this number to cell reference
    Increment = Start + i - 1
    shT.Copy After:=Sheets(xName)
    Set shN = ActiveSheet
    shN.Name = shC.Range("B12") & "-" & Increment
    xName = shN.Name
    shN.Range("A1") = shC.Range("B12") & " Factory Acceptance Test Report"
    shN.Range("I4") = shC.Range("B8") & "-" & Increment
    shN.Range("I2") = shC.Range("B12")
    shN.Range("I5") = shC.Range("B13")
    shN.Range("I6") = shC.Range("B14")
    shN.Range("I7") = shC.Range("B15")
    shN.Range("J10") = shC.Range("B17")
    shN.Range("J12") = shC.Range("B18")
    shN.Range("N14") = shC.Range("B19")
    shN.Range("O32") = shC.Range("B20")
    shN.Range("D41") = shC.Range("B21")
    shN.Range("D43") = shC.Range("B15")
    shN.Range("I3") = shC.Range("F" & 7 + i)
  Next
  shC.Activate
End Sub

 

[ChaosPup]

Try

TagNum = Sheets("Control").Range("F8").Offset(I)

That's done it, thank you very much!

 

[Fluff]

Glad we could help & thanks for the feedback.