Macro copy one row at a time

Hi to all

I'm new with vba programming so let me explain what's my problem. I would really appreciate if someone can help me.
I have many combinations located in spreadsheet ''COMB'' in cell from b1:f1 in 792 rows. I would like to copy each row at a time to the spreadsheets ''WGP'' in cell from b4:b8 and then run my existing macro which run excel solver and then copy results to the b48 and bellow

All I need is a code that will automatically copy one row at a time, run solver and copy results to another location and then copy next row and so on till end of a list of rows


I attach my excel file and existing macros which was run manual by button, but now I want to automatic run all by some kind of a loop.
Thanks in advance. Josef


Excel solver code

Private Sub CommandButton2_Click()
SolverOk SetCell:="$K$3", MaxMinVal:=2, ValueOf:=0, ByChange:="$I$4:$I$8", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverOk SetCell:="$K$3", MaxMinVal:=2, ValueOf:=0, ByChange:="$I$4:$I$8", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverSolve
End Sub

copy in two row based on number of scenario

Private Sub CommandButton3_Click()
stc = Excel.Range("I2").Value
    
    Range("B4:B8").Select
    Selection.Copy
    Range("B47").Select
    ActiveCell.Offset(stc, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("B48").Select
    
Range("I4:I8").Select
    Selection.Copy
    Range("A48").Select
    ActiveCell.Offset(stc, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A49").Select
    
  Range("c14:c18").Select
    Selection.Copy
    Range("f48").Select
    ActiveCell.Offset(stc, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("f49").Select
End Sub

now i have a button which move manualy to the next scenario number

Dim intDV As Integer
Dim ws As Worksheet
Dim c As Range
Dim rngList As Range

Set ws = Sheets("WGP")
Set c = ws.Range("I2")
Set rngList = ws.Range("STEVILA ")
intDV = 0
On Error Resume Next
intDV = Application.WorksheetFunction.Match(c.Value, rngList, 0)

If intDV = 0 Or intDV = 1 Then
  c.Value = rngList.Cells(rngList.Rows.Count, 1)
Else
  c.Value = rngList.Cells(intDV - 1, 1)
End If
End Sub