Копирование / вставка ячеек Excel в Word в цикле не работает / не сохраняется должным образом

Question

По общему признанию, новичок в VBA. У меня есть файл Excel, который состоит из всех наших номеров деталей, разделенных символами «-», которые я написал для разбивки на более описательные фразы для создания меток. Я пытаюсь написать здесь код для циклического перебора различных типов номеров деталей, захвата отдельных ячеек в строке этой части # и копирования / вставки их в текстовый документ и сохранения слова doc в качестве имени части #. Как и раньше, он зацикливается, но захватывает всю информацию из разных диапазонов, а не только информацию из той же строки, что и деталь.

Код работает (помимо сохранения), если я изменяю диапазоны на 1 одну ячейку, нокак только у меня есть несколько ячеек в диапазонах, он начинает копировать все в диапазоне, а не только в строке той части, которую он должен зацикливать.

Sub exceltoword2()

Dim part As Range
Dim funct As Range
Dim finish As Range
Dim lever As Range
Dim backset As Range
Dim trim As Range

Set part = Range("A2:A5")
Set funct = Range("Q2:Q5")
Set finish = Range("R2:R5")
Set lever = Range("S2:S5")
Set backset = Range("T2:T5")
Set trim = Range("U2:U5")

Dim wdapp As Word.Application
Set wdapp = New Word.Application
Dim SaveName As String

Dim path As String
path = "C:\Users\bpickett\Desktop\Parts\"

For Each part In part 'Long list of part #'s that will be looped through with particular variables commented out as needed as I adjust range on part variable

     With wdapp
    .Visible = True
    .Documents.Add
    .Activate

    part.Copy '********************************Part copied
    .Selection.PasteSpecial
        With .Selection '**********************Function copied
            .Font.Name = "Calibri"
            .Font.Size = 22
            .TypeText "FUNCTION       " '7 spaces
        End With
    funct.Copy
    .Selection.PasteSpecial
    With .Selection '**************************Finish
            .Font.Name = "Calibri"
            .Font.Size = 22
            .TypeText "FINISH              " '14 spaces
        End With
    finish.Copy
    .Selection.PasteSpecial
    With .Selection '***************************Backset
            .Font.Name = "Calibri"
            .Font.Size = 22
            .TypeText "BACKSET          " '10 spaces
        End With
    backset.Copy
    .Selection.PasteSpecial
   ActiveDocument.SaveAs2 path & part & ".docx"
End With
Next
End Sub

Код при запуске имеет правильную 1-ю часть, затем просто копирует весь диапазон Backset / Function / Finish под каждым, а не только одну ячейку в строке номера детали.

Answer 1

Воспользовавшись советами из вышеприведенных комментариев, провел на несколько дней больше исследований и внес некоторые изменения, которые решили все проблемы.

For i = 1 to 1275
Set part = Range("A" & i)
Set funct = Range("Q" & i)
Set finish = Range("R" & i)
Set lever = Range("S" & i)
Set backset = Range("T" & i)
Set trim = Range("U" & i)

Квалификация диапазонов (или, по крайней мере, мне это удалось) и добавление iмассив, а не для каждой части, был огромен, чтобы код мог зацикливаться и захватывать только необходимую информацию. Но во время работы он очень часто вылетал с ошибкой 4605. Но 7-летний вопрос, на который здесь был дан ответ, окружил команды копирования / вставки метками и обработчиком ошибок

Pg1CopyAttempt:
DoEvents
part.Copy
On Error GoTo Pg1PasteFail
.selection.pastespecial
On Error goto 0 'disable the error handler

Pg1PasteFail:
If Err.Number = 4605 Then ' clipboard is empty or not valid.
    DoEvents
    Resume Pg1CopyAttempt
 End If

, который работал безупречно для прохождения строк из 100-х или 1000-х циклов (созданные файлы). Просто пришлось изменить Pg1 до 2 и 3 и ввести код.