Copy Excel range a number of sheets as pictures to MS Word, each picture on new Word page.

Good day,

I am busy with a major selection program which is excel base, however, I cannot seem to fix a small issue with one of my sub-routines. To explain what the sub-routine should do: an Excel workbook will have a number of sheets, each containing a range which is already set as the print area. I wrote VBA code for this print area range to be copied into a word document which works. I also wrote VBA code to loop through all sheets in the Workbook and copy the respective range to Word, which also works (the loop works, and each copy instance woks). Just to clarify, there are sheets that should not be copied - the sheets that contain the range that should be copied are identified by the program with a "2" in the first cell "A1" of the sheets where the range must be copied. Hence, the IF function in the FOR loop below.

The problem is that each subsequent range is copied on top of one another at the start of the Word document, and in the end only one picture of the range is copied. The pictures should be copied inline beneath one another, maybe separated with a paragraph character. The code I have is as per below (I have removed all previous attempts made to fix this):

Sub PastWord()

Dim exlWB As Excel.Workbook
Set exlWB = ActiveWorkbook
Dim appWord As Word.Application
Set appWord = New Word.Application
appWord.Visible = True
Dim Doc As Word.Document
Set Doc = appWord.Documents.Add
Doc.PageSetup.Orientation = wdOrientLandscape
Doc.PageSetup.TopMargin = 3
Doc.PageSetup.BottomMargin = 3
Doc.PageSetup.RightMargin = 3
Doc.PageSetup.LeftMargin = 3

Dim PrtArRg As Range

Dim nos As Integer  ' nos is Number of Sheets
nos = exlWB.Sheets.Count

Dim nosc As Integer ' nosc is Counter for For function

For nosc = 1 To nos
    If exlWB.Sheets(nosc).Cells(1, 1) = 2 Then ' "2" indicates the sheets that contain the range to be copied
             
                
        Set PrtArRg = exlWB.Sheets(nosc).Range(ActiveSheet.PageSetup.PrintArea)
        PrtArRg.CopyPicture Appearance:=xlScreen, Format:=xlPicture
            
        Doc.Content.Paste
        
        Else
    End If
Next nosc
    
End Sub