Renaming Sheets

I have a macro that takes a sheet and splits it into several different sheets, using various loops.

I am trying to rename the sheets using this code

                If Range("G2").Value = "Risk" Then
                ActiveSheet.Name = "R-" & Range("H2").Value
                ElseIf Range("G2").Value = "Issue" Then
                ActiveSheet.Name = "I-" & Range("H2").Value
                ElseIf Range("G2").Value = "Opportunity" Then
                ActiveSheet.Name = "O-" & Range("H2").Value
                End If

It just runs through and doesn't change the name of the sheet.

I tried this on the worksheet both on it's on and by adding it to my code and it does nothing.

Now the values being used come from cells that I used Text to Columns on. I have no idea if that makes any difference or not. But I have used this code in other macros and it was fine.

Here is the full code of the macro, maybe this will help

Sub Macro1()
'
' 
'

'Copy and edit original sheet

Sheets.Add After:=Sheets(Sheets.Count)
Sheets("RiskListWithResponses").Select
Cells.Select
Selection.Copy
Sheets(Sheets.Count).Name = "Copy"
Sheets("Copy").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
    , SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Hyperlinks.Delete
With Selection
    .Orientation = 0
    .AddIndent = False
    .ShrinkToFit = False
    .MergeCells = False
End With
With Selection.Font
    .Name = "Arial"
    .Size = 10
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
End With
With Selection.Font
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
End With
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("F:N").Select
Selection.Delete Shift:=xlToLeft
Rows("1:7").Select
Range("A6").Activate
Selection.Delete Shift:=xlUp
Columns("C:E").EntireColumn.AutoFit
Columns("B:B").ColumnWidth = 62.29
Cells.Select
With Selection
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .ShrinkToFit = False
    .MergeCells = False
End With
    
'Add borders
Columns("A:E").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
   

'Loops to create new sheets

Dim RowCount As Integer
Dim RowA As Integer
Dim RowB As Integer
Dim LContinue As Integer
Dim LastRow As Integer





'Initiate Variables
RowA = 1
RowB = 1
LastRow = ActiveSheet.UsedRange.Rows.Count + 1



Do While RowA <> LastRow
    RowA = RowA + 1
    
    If (Range("A" & CStr(RowA))) <> "" Then
        RowB = RowA
        LContinue = True
        
        Do While LContinue = True
            RowB = RowB + 1
        
            If (Range("A" & CStr(RowB))) <> "" And (Range("B" & CStr(RowB))) <> "" Then
                 RowB = RowB - 1
                 LContinue = False
            
            ElseIf (Range("A" & CStr(RowB))) = "" And (Range("B" & CStr(RowB))) = "" Then
                 LContinue = False
            
            Else: LContinue = True
        
            End If
             
        Loop
        
'Create and edit new sheet
        
        Rows(RowA & ":" & RowB).Select
        Selection.Copy
        Sheets.Add After:=Sheets(Sheets.Count)
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ActiveSheet.Paste
     
     
'Set up to rename sheets

        Columns("A:A").Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlToLeft
   
        If (Range("A4")) = "" Then
            Application.DisplayAlerts = False
            ActiveWindow.SelectedSheets.Delete
            Application.DisplayAlerts = True
        Else
            Range("A1").Select
            Selection.Copy
            Range("G1").Select
            Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            ActiveSheet.Paste
            Application.CutCopyMode = False
            Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
                TrailingMinusNumbers:=True
                Columns("G:I").EntireColumn.AutoFit
             
            Do While IsNumeric([H1]) <> True
                Columns("H").Select
                Selection.Delete Shift:=xlToLeft
               
            Loop
            
                        Range("G1:H1").Select
            Selection.Copy
            Range("G2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                
            Range("A1").Select
            


        End If
        
        
                If Range("G2").Value = "Risk" Then
                ActiveSheet.Name = "R-" & Range("H2").Value
                ElseIf Range("G2").Value = "Issue" Then
                ActiveSheet.Name = "I-" & Range("H2").Value
                ElseIf Range("G2").Value = "Opportunity" Then
                ActiveSheet.Name = "O-" & Range("H2").Value
                End If
        
           
        
            Sheets("Copy").Select
        End If
          

Loop

'Rename Sheets




End Sub

I have uploaded a Dummy worksheet

DUMMY2.xls

This one should work a bit better as I ranamed some cells for it to work.

DUMMY2.xls

I wil have to make some edits to that worksheet

OK... What I did was take A1 and used the Text to Columns to seperate the data in A1 so I can use it. It may have had something like, Issue - I-10 - Problem name and details or Risk - 2 - Risk name and details

This database wasn't exactly normalized so it gets tricky.

I seperated A1 by the deliminater -
Then I did some checks just to get Issue in one cell and the number in the next cell
I created a G2 and H2 just to check things out but G1 and H1 could be used as well.

A2 is not merged

DUMMY3.xls


Sorry, I posted the DUMMY2 worksheet before I left work on Friday.
I have reposted DUMMY3 and it has the actual code that is to be used. Maybe this will make more sense.
The Macro unmerges the cells so there are no merged cells being used.

You need to run the macro that I have created and posted... I made a copy of the orginal sheet and unmerged the cells and got rid of extra columns.

Thank you tlafferty, that solved my problem.