Loop to insert picture in correspondingly named workbook

Question

I am trying to insert the correct country map JPG in the correct country XLSX. By "correct" I mean there is one map for each XLSX - Albania.jpg into Albania.xlxs, Andorra.jpg into Andorra.xlxs, etc.

My macro is to do the following:

1. Enter country name and year in User Form worksheet cells B2 and B3 (works fine!).
2. Enter country population and income level in Countries worksheet cells B1 and E1 (works fine!).
3. Insert country map JPG in User Form worksheet at cell A18 (cannot get this to loop!).
4. Save the workbook as CountryName.xlxs (works fine!).

I have tried using Filename = Dir(Path & "*.jpg") and ActiveSheet.Pictures.Insert without success. I think I need to use ActiveSheet.Pictures.Insert because the cells above the map's position (cell A18) will expand and the map needs to move down.

Sub SaveCountryYear_XLSX_English_map()

Dim lRow, x As Integer
Dim wbName As String
Dim MapPath As String 'Not used in example below
Dim MapName As String 'Not used in example below
Dim index As Integer

Application.DisplayAlerts = False
Application.ScreenUpdating = False

lRow = Range("A" & Rows.Count).End(xlUp).Row
x = 1
Do
x = x + 1

Worksheets("Countries").Activate

'1. Enter country name and year in User Form worksheet cells B2 and B3.

    Range("A" & x).Select
    Selection.Copy
    Sheets("User Form").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Countries").Select
    Range("B" & x).Select
    Selection.Copy
    Sheets("User Form").Select
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

'2. Enter country population and income level in Countries worksheet cells B1 and E1.

    Sheets("Countries").Select
    Range("C" & x).Select
    Selection.Copy
    Sheets("Table").Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Countries").Select
    Range("D" & x).Select
    Selection.Copy
    Sheets("Table").Select
    Range("E1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

'3. Insert country map JPG in User Form worksheet at cell A18 
'(cannot get this to loop!). 
'The following is just an example - it works, 
'but without loop of course (inserts the named file correctly).

    Sheets("User Form").Select
    Range("A18").Select
    ActiveSheet.Pictures.Insert( _
        "C:\temp\profiles\2017\Maps\EN JPGs\Albania_EN.jpg").Select

Sheets("Countries").Select

'4. Save the workbook as CountryName.xlxs.

    wbName = Range("A" & x).Value & "_" & Range("B" & x).Value & "_EN"
    ActiveWorkbook.SaveAs Filename:="C:\temp\profiles\2017\Production\Batch_EN_1\" _ 
        & wbName & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Loop Until x = lRow

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Answer 1

edited after OP's clarifications

you may want to try this refactored code:

Option Explicit

Sub SaveCountryYear_XLSX_English_map()

    Dim wbName As String
    Dim MapPath As String 'Not used in example below
    Dim MapName As String 'Not used in example below
    Dim index As Integer  'Not used in example below
    Dim cell As Range

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False


    With Worksheets("Countries") '<--| reference "Countries" worksheet of your currently active workbook
        For Each cell In .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues) '<--| loop through referenced worksheet column A cells filled with some text from A2 down to last not empty one

        '1. Enter country name and year in User Form worksheet cells B2 and B3.

            Worksheets("User Form").Range("B2").value = cell.value '<--| name is in current cell
            Worksheets("User Form").Range("B3").value = cell.Offset(, 1).value '<--| date is in adjacent cell

        '2. Enter country population and income level in Countries worksheet cells B1 and E1.

            Worksheets("Table").Range("B1").value = cell.Offset(, 2).value '<--| population is in cell two columns right of current one
            Worksheets("Table").Range("E1").value = cell.Offset(, 3).value '<--| income level is in cell three columns right of current one


        '3. Insert country map JPG in User Form worksheet at cell A18
        '(cannot get this to loop!).
        'The following is just an example - it works,
        'but without loop of course (inserts the named file correctly).

            Worksheets("User Form").Activate
            Range("A18").Select
            ActiveSheet.Pictures.Insert _
                "C:\temp\profiles\2017\Maps\EN JPGs\" _
                & cell.value & "_EN.jpg"


        '4. Save the workbook as CountryName.xlxs.
            Worksheets.Copy '<--| copy current workbook worksheets to a new workbook
            ActiveWorkbook.SaveAs Filename:="C:\temp\profiles\2017\Production\Batch_EN_1\" _
                & wbName & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            ActiveWorkbook.Close
        Next cell

    End With

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

where:

• you have to adapt:

  ActiveSheet.Pictures.Insert _
          "C:\temp\profiles\2017\Maps\EN JPGs\" _
          & cell.value & "_EN.jpg"
  

  to your actual filenames and source path conventions

• I changed section 4 (Save the workbook as CountryName.xlxs)