ExcelからExcelへのループをコピーして、コマンドエラーが発生する

Question

このコードを実行して、コード内に定義されている2つのセルの間でExcelからセルを選択し、特定のブックマークの場所に貼り付けます。しかし、これまでコードを実行すると、 "start_of_text"、 "end_of_text"、 "Start_of_table"、 "End_of_table"の間の最初のセルで動作しますが、2番目のtextemarke.pastespecial（xlPasteall） 'コマンドが失敗しました。

誰もが何か提案がありますか？

Dim rownum As Integer 
    Dim colnum As Integer 
    Dim startrow As Integer 
    Dim endrow As Integer 
    Dim textmarke 

    rownum = 1 
    colnum = 2 

' Filtering for T1 line 

    ThisWorkbook.Worksheets("Template-Referenz-Produkte").Columns("A:A").AutoFilter Field:=1, Criteria1:="=<T1 Line>" _ 
    , Operator:=xlOr 


    ' Find eveything between start of text and end of text 
    With ThisWorkbook.Worksheets("Template-Referenz-Produkte") 
    For rownum = 1 To 10000 
     Do 
     If .Cells(rownum, 2).Value = "Start_of_text" Then 
      startrow = rownum + 1 
      End If 
      rownum = rownum + 1 

     If (rownum > 10000) Then Exit For 

     Loop Until .Cells(rownum, 2).Value = "End_of_text" 
     endrow = rownum - 1 

     'Select everything from start of text to end of text 
     ThisWorkbook.Worksheets("Template-Referenz-Produkte").Range("B" & startrow & ":B" & endrow).Copy 

     'Paste description from excel sheet 
     Set textmarke = doc.Bookmarks("INSERT_T1_LINE_reference_TABLE").Range 
     textmarke.PasteSpecial (xlPasteAll) 
     textmarke.Style = "Heading 4" 
     doc.Bookmarks.Add "INSERT_T1_LINE_reference_TABLE", textmarke 'Set the text marker on this specific range. 

    ' Find everything between start of table and end of table 
     Do 
      If .Cells(rownum, 2).Value = "Start_of_table" Then 
      startrow = rownum + 1 
      End If 
      rownum = rownum + 1 

     If (rownum > 10000) Then Exit For 

     Loop Until .Cells(rownum, 2).Value = "End_of_table" 
     endrow = rownum - 1 

     'Select everything from start of table to end of table 
     ThisWorkbook.Worksheets("Template-Referenz-Produkte").Range("B" & startrow & ":E" & endrow).Copy 

     'Paste description from excel sheet 
     Set textmarke = doc.Bookmarks("INSERT_T1_LINE_reference_TABLE").Range 
     textmarke.PasteSpecial (xlPasteAll) 
     doc.Bookmarks.Add "INSERT_T1_LINE_reference_TABLE", textmarke 'Set the text marker on this specific range. 

    Next rownum 
    End With 

Answer 1

代わりのtextMarke.PasteSpecialあなたは試みることがあります。

textMarke.Select 
doc.Parent.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"