Transfer results from Excel to Word

[krackers]

I have an excel workbook that passes details of members to a word document. The current code all works fine and passes the names to a series of columns in a table within a word document. Each member has four pieces of information passed across - membership number, title, first name and last name - so taking up 4 columns. The table has 9 columns so each row has two members details with the central column left blank. The information is passed a row at a time in alphabetical order. The code used is below.

What I am trying to achieve is to change it so the member details are pasted down a page (using columns 1-2-3-4) and then at the foot of the first page it starts at the top of that same page leaving column 5 blank and pasting the next name alphabetically down the page (using columns 6-7-8-9). Once that A4 page is full it starts on the next page.

Any help adjusting the code would be hugely appreciated.



ub XLWordCurrentMembers()
'xl transfer to different sheet and then different sheet to Word table
Dim WrdApp As Object, FileStr As String, Arr2() As Variant, RowCnt As Integer
Dim WrdDoc As Object, TblCell As Variant, Temp As Double, Cnt4 As Integer
Dim Lastrow As Integer, Cnt As Integer, Cnt2 As Integer, CntA As Integer, Cnt3 As Integer
Dim ARR() As Variant, Lastrow2 As Integer, LastCol As Integer, rng As Range
' clear old sheet
Sheets("CurrentMembers").Rows("1:" & Sheets("CurrentMembers").Rows.Count).ClearContents
'set #rows & #columns for transfer
With Sheets("Membership")
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
'load transfer rows as ranges to array(1)
ReDim ARR(Lastrow)
With Sheets("Membership") '
For Cnt = 1 To Lastrow
If .Cells(Cnt, 24).value = "renewed" Then
CntA = CntA + 1
ReDim Preserve ARR(CntA)
Set rng = .Range(.Cells(Cnt, 1), .Cells(Cnt, LastCol))
ARR(CntA - 1) = rng
End If
Next Cnt
End With
'transfer array(1) ranges to different sheet below lastrow
With Sheets("CurrentMembers")
For Cnt2 = LBound(ARR) To UBound(ARR) - 1
If .Range("B" & 1).value = vbNullString Then
Lastrow2 = 0
Else
Lastrow2 = .Range("B" & .Rows.Count).End(xlUp).Row
End If
.Range(.Cells(Lastrow2 + 1, "B"), .Cells(Lastrow2 + 1, LastCol + 1)) = ARR(Cnt2)
Next Cnt2
End With
'load 4 columns of different sheet to array(2) for tranfer to Word
Lastrow2 = Lastrow2 + 1
ReDim Arr2(Lastrow2, 4)
For Cnt3 = 1 To 4
For Cnt4 = 1 To Lastrow2
Arr2(Cnt4 - 1, Cnt3 - 1) = Sheets("CurrentMembers").Cells(Cnt4, Cnt3 + 1)
Next Cnt4
Next Cnt3


FileStr = "F:\FullMembershipList\\wordDoc\CurrentMembers.docx" '********** change address to suit
'determine number of Word table rows (x2 sheet ranges/rows from array(2) per table row)
Temp = WorksheetFunction.RoundUp((Lastrow2 / 2), 0)
On Error GoTo ErFix
'open existing Word doc
Set WrdApp = CreateObject("Word.Application")
WrdApp.Visible = False
Set WrdDoc = WrdApp.Documents.Open(FileStr)
With WrdDoc
'clear doc
.Range(0, .Characters.Count).Delete
'add table and header
.tables.Add WrdApp.Selection.Range, NumRows:=Temp + 1, NumColumns:=9
.tables(1).cell(1, 1).Range = "Number"
.tables(1).cell(1, 2).Range = "Title"
.tables(1).cell(1, 3).Range = "First"
.tables(1).cell(1, 4).Range = "Last"
.tables(1).cell(1, 6).Range = "Number"
.tables(1).cell(1, 7).Range = "Title"
.tables(1).cell(1, 8).Range = "First"
.tables(1).cell(1, 9).Range = "Last"
'fill table from array(2)
For Cnt4 = 0 To Lastrow2 - 1
RowCnt = RowCnt + 1
For Cnt3 = 0 To 3
.tables(1).cell(RowCnt + 1, Cnt3 + 1).Range = Arr2(Cnt4, Cnt3)
.tables(1).cell(RowCnt + 1, Cnt3 + 6).Range = Arr2(Cnt4 + 1, Cnt3)
Next Cnt3
Cnt4 = Cnt4 + 1
Next Cnt4
End With
WrdApp.ActiveWindow.View.TableGridlines = True
'close, save, quit Word and clean up
WrdApp.ActiveDocument.Close savechanges:=True
Set WrdDoc = Nothing
WrdApp.Quit
Set WrdApp = Nothing
MsgBox "Finished sorting Data. Open the MS Word document 'CurrentMembers.docx' for list to be printed"
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "error"
Set WrdDoc = Nothing
WrdApp.Quit
Set WrdApp = Nothing
End Sub

[macropod]

This would be a trivial undertaking using a label mailmerge - without ever needing to open the Excel workbook, let alone any VBA - using a two-column page layout with a 4-column table snaking from the top of one column to the bottom of the next and a suitably-sized column spacing in between.

[krackers]

This would be a trivial undertaking using a label mailmerge - without ever needing to open the Excel workbook, let alone any VBA - using a two-column page layout with a 4-column table snaking from the top of one column to the bottom of the next and a suitably-sized column spacing in between.


But the data is held in an excel workbook, updated, added to and stored in that environment. Excel is then used to sort the data required that then feeds into the word document. Hence the desire to keep it in this form. It is a charitable organisation run entirely by volunteers hence the desire to keep things as automated as possible and avoid spending time producing each month. (The output list of members produced is issued each month and currently that is simply done by pushing a button in excel, opening results Word document and printing a hard copy; only issue is it is not in the best format for its then intended use.)

I am not an expert in Word and certainly do not use mailmerge. If you are saying I can easily transpose the data from current Word output to required output in a very simple way then I'd love to know more.

[macropod]

But the data is held in an excel workbook, updated, added to and stored in that environment
. Excel is then used to sort the data required that then feeds into the word document.
...
I am not an expert in Word and certainly do not use mailmerge. If you are saying I can easily transpose the data from current Word output to required output in a very simple way then I'd love to know more.
That is precisely what mailmerge is for - taking data from, for example, Excel and outputting it in Word.

See:
https://support.office.com/en-gb/article/Use-mail-merge-for-bulk-email-letters-labels-and-envelopes-f488ed5b-b849-4c11-9cff-932c49474705
https://support.microsoft.com/en-gb/help/318118/how-to-use-the-mail-merge-feature-in-word-to-create-and-to-print-form
https://support.office.com/en-us/article/Mail-merge-using-an-Excel-spreadsheet-858C7D7F-5CC0-4BA1-9A7B-0A948FA3D7D3

[krackers]

Thanks macropod. After a bit of reading and thinking, I have managed to use mailmerge to create what I am after, many thanks. In order to get things exactly as I wanted, I had to create a table for the mailmerge and then create two columns in the word document to get it to repeat on the page. It was this second column aspect that took me a while to realise as the way forward and to achieve what I was after. That's because I am a relative novice when it comes to word! But after all the hunting and reading I now also know and understand a lot more about word.