Help with coding (Macro)

I am a bit new to coding and I would require some help with creating a macro in excel. What I need it to do is to copy a range of cells (multiple columns) depending on the value in a cell above each column and paste them in Word table. In attachment is the excel table I am refering to. In excel, I made an equation that when you increase the number of test and reference the following change is made: (1) Test --> (2) Test 1 and Test 2 --> (3) Test 1 Test 2 and Test 3 and the same goes for the reference. So the higher the number of Test and Reference, the more columns I need to copy paste into Word document (so only the columns that have Test, Test 1,... Reference, Reference 1,... should be copied into Word; excluding the ones that have empty cells above the column in table). That is the first part (first Word document filled).

the second part is: I need to create a few more Word documents. This time I need to copy individual coulms from excel to Word document (same excel file, just a new macro). I would like to copy the column with the value Test into a Word document then if Test 1 also exists create a second document and paste the column that has Test 1 in cell above into Word and so on until max Test 4 (and the same for reference). In case I had 4 coulms with Test (Test 1, Test 2, Test 3 and Test 4) in Excel, I would create 4 Word documents with 4 different Tables (using 1 Word template document).

If anyone likes a challenge, you can give it a go. Would help me ease my job a bit :)

Attachment 16555

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.

Code:

---

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

---

Solved it by myself. Tnx anyways. the second part was a bit trickier but solved it by creating multiple macros and then one macro that chooses the right one based on the value of one cell.

first part:

Code:

---

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
    Dim WdRange As Word.Range
    Dim number 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"
    number = Sheets("Zdravila").Range("E4")
   
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If wdApp Is Nothing Then Set wdApp = CreateObject("Word.Application")
   
    If number = 1 Then Sheets("Zdravila").Range("table01").Copy
    If number = 2 Then Sheets("Zdravila").Range("table012").Copy
    If number = 3 Then Sheets("Zdravila").Range("table0123").Copy
    If number = 4 Then Sheets("Zdravila").Range("table01234").Copy
    If number = 5 Then Sheets("Zdravila").Range("table012345").Copy
    If number = 6 Then Sheets("Zdravila").Range("table0123456").Copy
   
    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
       
        Set WdRange = .ActiveDocument.Bookmarks("tabela").Range
        On Error Resume Next
        If number > 0 Then WdRange.Tables(1).Delete
        If number > 0 Then WdRange.Paste
       
        .ActiveDocument.Tables(1).AutoFitBehavior (wdAutoFitWindow)
       
        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.Application.Activate
        '.ActiveDocument.Close
   
    End With
    Set wdApp = Nothing
    Set WdRange = Nothing
    Application.CutCopyMode = False
   
End Sub

---