السلام عليكم ورحمة الله وبركاته
هذا الكود يقوم بالترحيل من الاكسيل إلى الوورد ولكن المشكلة كلما زدت المدى لا يتم ترحيل شيء فما المشكلة التي في هذا السطر
wdDoc.ActiveWindow.Selection.Tables(1).PreferredWidth = CentimetersToPoints(13)
'Name of the existing Word doc.
Const stWordReport As String = "Quarter Report.docx"
'Word objects.
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdbmRange As Word.Range
'Excel objects.
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnReport As Range
'Initialize the Excel objects.
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Sheet1")
Set rnReport = wsSheet.Range("A1:D53954")
'Initialize the Word objets.
Set wdApp = New Word.Application
rnReport.Copy
Set wdDoc = wdApp.Documents.Add(Template:="Normal", NewTemplate:=False, DocumentType:=0)
wdApp.Visible = True
wdDoc.Activate
rnReport.Copy
wdDoc.ActiveWindow.Selection.PasteExcelTable False, False, False
wdDoc.ActiveWindow.Selection.Tables(1).Rows(2).HeadingFormat = True '. .Select
wdDoc.ActiveWindow.Selection.Tables(1).PreferredWidth = CentimetersToPoints(13)
With wdDoc.ActiveWindow.Selection.PageSetup
.TopMargin = CentimetersToPoints(2)
.BottomMargin = CentimetersToPoints(2)
.LeftMargin = CentimetersToPoints(1.5)
.RightMargin = CentimetersToPoints(1.5)
.Gutter = CentimetersToPoints(0)
End With
Set wdbmRange = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing
'Clear out the clipboard, and turn screen updating back on.
With wbBook.Application
.CutCopyMode = False
.ScreenUpdating = True
End With
MsgBox "Done"
End Sub