Option Explicit
Public Const NumCountry As Integer = 190
Public arrCountry(1 To NumCountry) As String

Sub ДАЛЕЕ()
''надо дописать код
End Sub

Public Sub buttCountry(nameCountry As String, numButt As Integer)
Dim i As Integer
Dim str1 As String

If arrCountry(1) = "" Then Call setArr
With Worksheets("basa")
For i = 1 To NumCountry
    If arrCountry(i) = nameCountry Then Exit For
Next i
ActiveSheet.Cells(7, 4) = .Cells(i, 2)
ActiveSheet.Cells(8, 4) = .Cells(i, 4)
ActiveSheet.Cells(9, 4) = .Cells(i, 3)
Call DeleteShapesInRange
str1 = .Cells(i, 5)
pastePic (str1)
End With
End Sub

Sub pastePic(str1 As String)
'
    Sheets("basa").Select
    ActiveSheet.Shapes.Range(Array(str1)).Select
    Selection.Copy
    Sheets("Лист1").Select
    Range("C4").Select
    ActiveSheet.Paste
End Sub

Public Sub setArr()
Dim i As Integer

For i = 1 To NumCountry
    arrCountry(i) = Worksheets("basa").Cells(i, 1)
Next i
End Sub
'
' эти две функции честно стырены на просторах инета
Sub DeleteShapesInRange()
    Dim ra As Range: Set ra = ActiveSheet.Cells(4, 3) ' задаём диапазон для поиска картинок
    On Error Resume Next    ' на случай, если картинок в заданном диапазоне нет
    ShapesInRange(ra).Delete    ' удаляем все картинки в диапазоне ra
End Sub
Function ShapesInRange(ByRef ra As Range) As ShapeRange
    On Error Resume Next: Dim a(), i&, n&, Shps As Shapes
    Set Shps = ra.Worksheet.Shapes
    If Shps.Count = 0 Then Exit Function
    ReDim a(1 To Shps.Count)

    For i = 1 To Shps.Count
        With Shps.Item(i)
            If .Type = msoPicture Or .Type = msoLinkedPicture Then
                If Not Intersect(ra.Worksheet.Range(.TopLeftCell, .BottomRightCell), ra) Is Nothing Then
                    n = n + 1: a(n) = i
                End If
            End If
        End With
    Next
    If n Then ReDim Preserve a(1 To n): Set ShapesInRange = Shps.Range(a)
End Function

Option Explicit
Public Const NUMCOUNTRY As Integer = 190
Public arrCountry(1 To NUMCOUNTRY) As String
Public arrNameShape(1 To NUMCOUNTRY) As String

Sub nextGen()
''надо дописать код
If arrCountry(1) = "" Then Call setArr
Call setButtCaption(4, 5, 6)

End Sub

Public Sub buttCountry(nameCountry As String, numButt As Integer)
Dim i As Integer
Dim str1 As String

If arrCountry(1) = "" Then Call setArr
With Worksheets("basa")
For i = 1 To NUMCOUNTRY
    If arrCountry(i) = nameCountry Then Exit For
Next i
ActiveSheet.Cells(7, 4) = .Cells(i, 2)
ActiveSheet.Cells(8, 4) = .Cells(i, 4)
ActiveSheet.Cells(9, 4) = .Cells(i, 3)

Call DeleteShapesInRange
Call pastePic(arrNameShape(i))
End With
End Sub

Sub pastePic(str1 As String)
Dim shp As Shape

Set shp = Worksheets("basa").Shapes(str1)

shp.Copy
ActiveSheet.Paste (ActiveSheet.Cells(4, 3))
ActiveSheet.Cells(4, 4).Select
End Sub

Public Sub setArr()
Dim i As Integer

With Worksheets("basa")
For i = 1 To NUMCOUNTRY
    arrCountry(i) = .Cells(i, 1)
    arrNameShape(i) = .Cells(i, 5)
    If i + 1 > .Shapes.Count Then Exit For
Next i
End With
End Sub
'
' эти две функции честно стырены на просторах инета
Sub DeleteShapesInRange()
    Dim ra As Range: Set ra = ActiveSheet.Cells(4, 3) ' задаём диапазон для поиска картинок
    On Error Resume Next    ' на случай, если картинок в заданном диапазоне нет
    ShapesInRange(ra).Delete    ' удаляем все картинки в диапазоне ra
End Sub
Function ShapesInRange(ByRef ra As Range) As ShapeRange
    On Error Resume Next: Dim a(), i&, n&, Shps As Shapes
    Set Shps = ra.Worksheet.Shapes
    If Shps.Count = 0 Then Exit Function
    ReDim a(1 To Shps.Count)

    For i = 1 To Shps.Count
        With Shps.Item(i)
            If .Type = msoPicture Or .Type = msoLinkedPicture Then
                If Not Intersect(ra.Worksheet.Range(.TopLeftCell, .BottomRightCell), ra) Is Nothing Then
                    n = n + 1: a(n) = i
                End If
            End If
        End With
    Next
    If n Then ReDim Preserve a(1 To n): Set ShapesInRange = Shps.Range(a)
End Function

Public Sub setButtCaption(i As Integer, j As Integer, k As Integer)

  With Worksheets("Лист1")
    .CommandButton1.Caption = arrCountry(i)
    .CommandButton2.Caption = arrCountry(j)
    .CommandButton3.Caption = arrCountry(k)
End With
End Sub