Loop to insert picture in correspondingly named workbook - vba

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:
Enter country name and year in User Form worksheet cells B2 and B3 (works fine!).
Enter country population and income level in Countries worksheet cells B1 and E1 (works fine!).
Insert country map JPG in User Form worksheet at cell A18 (cannot get this to loop!).
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)