For the first part, my code is as written below. I have connected multiple cells to 1 Word document. I just need to add/improve it so it can do as mentioned above.
Sub Shippingrecord()
Dim wdApp As Object
Dim strTMP1 As String
Dim strTMP2 As String
Dim strTMP3 As String
Dim strTMP4 As String
Dim strTMP5 As String
Dim strTMP6 As String
Dim strTMP7 As String
Dim Fname As String
Dim Auto As String
Dim Full As String
strTMP1 = Range("Osnove!B12")
strTMP2 = Range("Osnove!B13")
strTMP3 = Range("Osnove!B4")
strTMP4 = Range("Osnove!C4")
strTMP5 = Range("Mape!B88")
strTMP6 = Range("Mape!A88")
Fname = Sheets("Mape").Range("C12").Text
Auto = "\Shipping record"
Full = Fname & Auto & ".docx"
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If wdApp Is Nothing Then Set wdApp = CreateObject("Word.Application")
On Error GoTo 0
With wdApp
.Visible = True
.Documents.Open "document location" 'adapt
.ActiveDocument.Bookmarks("Koda").Range = strTMP1
.ActiveDocument.Bookmarks("CRO").Range = strTMP2
.ActiveDocument.Bookmarks("Sender").Range = strTMP3
.ActiveDocument.Bookmarks("Mail").Range = strTMP4
.ActiveDocument.Bookmarks("Naslov").Range = strTMP5
.ActiveDocument.Bookmarks("Kontakt").Range = strTMP6
If Not Dir(Full) = "" Then 'filename exists
Do
i = i + 1
Full = Fname & Auto & i & ".docx"
Loop Until Dir(Full) = "" ' loop till filename not found
End If
.ActiveDocument.SaveAs Filename:=Full
wdApp.Activate
'.ActiveDocument.Close
End With
Set wdApp = Nothing
End Sub