Transferring data from excel to MS word - vba

Question

I need a VBA code to update my word file. It which consists of some tables That has to be updated from excel file. Excel file consists of bearing data with different bearing numbers. And my report has to be updated with the bearing values. Like for my next report if I just enter the different bearing file it must read all the bearing data from that file.
This has to be done in 3 steps. I have attached a sample image. firstly identify the bearing name which is always in A column (In this case I need to find (248_R), 38,7 % ). Then select 6*6 matrix data (suppose I find the bearing data to be in A946 then I need to record data from B950 to G955) and then transfer to word file(Only the values to the table). I am a newbee in VBA coding please can someone help?
image of sample bearing name with matrix underneath
Image of what the tables look like in the word document:

Answer 1

The first part of copying the range you want is relatively easy. You can use the following code to copy your desired matrix. I am not sure about pasting to a word document yet, give me some more time on that.
(For now, if you run this macro, the range you want will be copied. You can then switch to your word document and hit Ctrl+V to paste it into the desired table.
Also, please check and see whether the following references have been added:
Option Explicit
Sub findBearingDataAndPasteToWord()
Dim i As Integer
Dim aCell As Range, rng As Range
Dim SearchString As String
Set rng = Range("A750:A1790")
SearchString = "(248_R), 38,7 %"
For Each aCell In rng
If InStr(1, aCell.Value, SearchString, vbTextCompare) Then
ActiveSheet.Range(Cells(aCell.row + 4, 1), Cells(aCell.row + 9, 6)).Copy
Dim wrdApp As Word.Application
Dim docWd As Word.Document
MsgBox "Please select the word document that you want to paste the copied table data into (after pressing OK)" & _
vbNewLine & vbNewLine & "Script written by takanuva15 with help from Stack Overflow"
docFilename = Application.GetOpenFilename()
If docFilename = "False" Then Exit Sub
Set docWd = getDocument(docFilename)
Set wrdApp = docWd.Application
wrdApp.Selection.EndKey Unit:=wdStory
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.PasteExcelTable False, True, False
Exit Sub
Else: End If
Next aCell
End Sub
'Returns the document with the given filename
'If the document is already open, then it returns that document
Public Function getDocument(ByVal fullName As String) As Word.Document
On Error Resume Next
Set wrdApp = GetObject(, "Word.Application")
If wrdApp Is Nothing Then Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Dim fileName As String
Dim docReturn As Word.Document
fileName = Dir(fullName)
Set docReturn = Word.Documents(fileName)
If docReturn Is Nothing Then
Set docReturn = Word.Documents.Open(fullName)
End If
On Error GoTo 0
Set getDocument = docReturn
End Function