VB[1]

Function GetSheetActualRows(name)
    If Right(rptfile, 3) = "xls" Then
        GetSheetActualRows = Sheets(name).[A65536].End(xlUp).Row
    Else
        GetSheetActualRows = Sheets(name).[A1048576].End(xlUp).Row
    End If
End Function

Function AddNewSheetIfNotExist(name)
    Dim ws As Worksheet
    For Each ws In Worksheets
        If ws.name = name Then Exit Function
    Next ws
    Worksheets.Add.name = name
End Function

Sub Test()
    baseSheet = "sheet1"
    accountSuit = "sheet2"
    NewSheet = "sheet3"
    
    
    '/
    AddNewSheetIfNotExist (NewSheet)
    Sheets(NewSheet).Range("1:65536").Clear
    
    baseRows = GetSheetActualRows(baseSheet)
    accountSuitRows = GetSheetActualRows(accountSuit)
    
    Sheets(NewSheet).Cells(1, 1).Value = "Operation"
    Sheets(NewSheet).Cells(1, 3).Value = "Account Rule Type"
    Sheets(NewSheet).Cells(1, 5).Value = "Segment Name"
    
    Sheets(NewSheet).Cells(1, 2).Value = Sheets(baseSheet).Cells(1, 1).Value
    Sheets(NewSheet).Cells(1, 4).Value = Sheets(baseSheet).Cells(1, 2).Value
    Sheets(NewSheet).Cells(1, 6).Value = Sheets(accountSuit).Cells(1, 1).Value
    
    
    Sheets(NewSheet).Rows(1).Font.Bold = True
    
    For i = 2 To baseRows Step 1
        For j = 2 To accountSuitRows Step 1
            newRow = (i - 2) * (accountSuitRows - 1) + j
            Sheets(NewSheet).Cells(newRow, 1).Value = "insert"
            Sheets(NewSheet).Cells(newRow, 3).Value = "ITEM CATEGORY"
            Sheets(NewSheet).Cells(newRow, 5).Value = "ACCOUNT"
            Sheets(NewSheet).Cells(newRow, 2).Value = Sheets(baseSheet).Cells(i, 1).Value
            Sheets(NewSheet).Cells(newRow, 4).Value = Sheets(baseSheet).Cells(i, 2).Value
            Sheets(NewSheet).Cells(newRow, 6).Value = Sheets(accountSuit).Cells(j, 1).Value
            
        Next
    Next
    
    Sheets(NewSheet).Columns(2).Interior.ColorIndex = 27
    Sheets(NewSheet).Columns(4).Interior.ColorIndex = 27
    Sheets(NewSheet).Columns(6).Interior.ColorIndex = 27

End Sub