excel - For Each two times or?

Question

I try to get a number copied from one list in one sheet to a new created sheet in specific cell. The code first check if there already exist a sheet with this name, if not it creates a new sheet and then add it and paste in a table from another sheet. After this is done I also want a number to be filled in from the list but I dont get it to work with FOR EACH as i did with first one. I really don't know how i shall do it? Im trying to get the inum to be written in each new sheet.

 `Sub Sample()
Dim ws As Worksheet
Dim Row As Long
Dim inu As Long
Dim i As Long

'~~> Set this to the relevant worksheet
Set ws = Sheets("R?d")
Set wsi = Sheets("R?d")

With ws
    '~~> Find last row in Column A
    Row = .Range("A" & .Rows.Count).End(xlUp).Row
With wsi
    inu = .Range("B" & .Rows.Count).End(xlUp).Row
    
    '~~> Loop through the range
    For i = 3 To Row
        '~~> Check if cell is not empty
        If Len(Trim(.Range("A" & i).Value2)) <> 0 Then
            '~~> Whatever this fuction does. I am guessing it
            '~~> checks if the sheet already doesn't exist
            If SheetCheck(.Range("A" & i)) = False Then
                With ThisWorkbook
                    '~~> Add the sheet
                    .Sheets.Add After:=.Sheets(.Sheets.Count)
                    '~~> Color the tab
                    .Sheets(.Sheets.Count).Tab.Color = RGB(255, 0, 0)
                    '~~> Name the tab
                    .Sheets(.Sheets.Count).Name = Left(ws.Range("A" & i).Value2, 30)
                    Sheets("Utredningsmall").Range("A1:B22").Copy Destination:=Sheets(Sheets.Count).Range("A1")
                    .Sheets(.Sheets.Count).Range("B4").Value = ws.Range("A" & i).Value
                    Columns("A:B").AutoFit
                    Rows("1:25").AutoFit
                        For j = 3 To inu
                            'If Len(Trim(Range("B" & inu).Value2)) <> 0 Then
                                Sheets(Sheets.Count).Range("B3").Value2 = wsi.Range("B" & j).Value2
                            'End If
                        Next j
                    End With
                End If
            End If
        Next i
    End With
End With

End Sub`

question from:https://stackoverflow.com/questions/65626225/for-each-two-times-or

Answer 1

Create Worksheets from List

Option Explicit

Sub createWorksheets()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' Workbook containing this code.
    
    Dim MyRange As Range
    With wb.Worksheets("R?d").Range("A3")
        Set MyRange = .Resize(.Worksheet.Cells(.Worksheet.Rows.Count, .Column) _
            .End(xlUp).Row - .Row + 1)
    End With
    
    Application.ScreenUpdating = False
    
    Dim MyCell As Range
    For Each MyCell In MyRange.Cells
        If Len(MyCell) > 0 Then
            If Not SheetCheck(wb, MyCell.Value) Then
                With wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
                    ' Data
                    wb.Worksheets("Utredningsmall").Range("A1:B22").Copy _
                        Destination:=.Range("A1")
                    .Range("B3").Value = MyCell.Offset(, 1).Value
                    .Range("B4").Value = MyCell.Value
                    .Name = Left(MyCell.Value, 30)
                    ' Formats
                    .Tab.Color = RGB(255, 0, 0)
                    .Columns("A:B").AutoFit
                    .Rows("1:25").AutoFit
                End With
            End If
        End If
    Next MyCell

    Application.ScreenUpdating = True

End Sub

Function SheetCheck( _
    wb As Workbook, _
    ByVal SheetName As String) _
As Boolean
    On Error Resume Next
    Dim sh As Object: Set sh = wb.Sheets(SheetName)
    On Error GoTo 0
    SheetCheck = Not sh Is Nothing
End Function