Блог

Итак, я новичок в Excel VBA, и мне дали проект, который требует копирования данных с листа 1 в новую книгу. Проблемы связаны с копированием, вставкой и вставкой новых строк. (Есть две подпрограммы, но вторая подпрограмма примерно такая же, и она требуется, пожалуйста, простите), спасибо.

 Sub CopyInfo()
    On Error GoTo Err_Execute

    wb1.Sheets("dataform").Range("L2:N2").Copy
    wb2.Sheets(shtname).Range("A2:C27").Rows("1:1").Insert Shift:=xlDown
    wb2.Sheets(shtname).Range("A2:C28").PasteSpecial (xlPasteValues)


    wb1.Sheets("dataform").Range("B2:B28").Copy
    wb2.Sheets(shtname).Range("D2").Insert Shift:=xlDown

    wb1.Sheets("dataform").Range("D2:D28").Copy
    wb2.Sheets(shtname).Range("F2").Insert Shift:=xlDown

    update

    wb1.Sheets("Setlist").Range("G2").Copy
    wb2.Sheets(shtname).Range("E2:E27").Rows("1:27").Insert Shift:=xlDown
    wb2.Sheets(shtname).Range("E2:E28").Paste1Special

   wb2.Sheets(shtname).Columns().AutoFit

Err_Execute:
    If Err.Number = 0 Then MsgBox "All have been copied!" Else _
    MsgBox Err.Description

End Sub


Sub update()

    wb1.Sheets("dataform").Range("D2:D28").Copy
    wb1.Sheets("dataform").Range("E2:E28").PasteSpecial
    wb1.Sheets("dataform").Range("F2:F28").PasteSpecial

    wb1.Sheets("dataform").Range("F2:F28").Copy
    wb2.Sheets(shtname).Range("G2").Insert Shift:=xlDown
End Sub
 

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

Итак, есть несколько шагов, чтобы достичь желаемого результата.

1. Я предполагаю, что ваша 2-я рабочая книга еще не открыта, поэтому вам нужно сначала открыть ее в VBA, прежде чем вы сможете скопировать свои диапазоны. В SO и Google есть множество ответов, которые покажут вам, как это сделать.
2. Поскольку вы будете добавлять строки в исходный лист, вам нужен способ включить это в свой код. Есть несколько вариантов, как это сделать.

   Вы можете создать таблицу и использовать Dim As ListObject для объявления, а затем установить ее в VBA. Таким образом, при добавлении новых строк в таблицу они будут автоматически включены. Второй способ — использовать динамический именованный диапазон (см. Диспетчер имен на вкладке Формулы), который включает новые строки при их добавлении.

3. Возможно, наиболее важной частью является упрощение кода путем объявления ваших переменных и объектов.

В настоящее время вы wb1.Sheets("dataform") постоянно пишете. Вместо этого используйте Dim DataForm as Worksheet и Set Dataform = wb1.Sheets("dataform") . Таким образом, при использовании адреса вашего листа вы можете просто написать Dataform.Range("A1:A1") . Пример см. Ниже.

     Dim Source As Workbook
    Set Source = ThisWorkbook
    Dim Dataform As Worksheet
    Set Dataform = Source.Sheets("Dataform")

    Dataform.Range("L2:N2").Copy 'See how you can just adress the sheet by name
 

Теперь, если бы вы также объявили свои диапазоны как таблицы / именованные диапазоны, это сделало бы код еще проще в обработке. Поскольку вы также всегда добавляете строку во время каждой операции, гораздо более эффективным способом было бы использовать a for each loop для просмотра всех ваших именованных диапазонов / таблиц, скопировать их, вставить новую строку в лист назначения, а затем вставить.

Надеюсь, это было какое-то вдохновение

 Sub CopyInfo()
    On Error GoTo Err_Execute

    dataform.Range("L2:N2").Copy
    wb2.Sheets(shtname).Range("A2").Rows("1:27").Insert Shift:=xlDown
    wb2.Sheets(shtname).Range("A2:C28").PasteSpecial (xlPasteValues)

    dataform.Range("LocationName").Copy
    wb2.Sheets(shtname).Range("D2").Insert Shift:=xlDown

    dataform.Range("Reading").Copy
    wb2.Sheets(shtname).Range("F2").Insert Shift:=xlDown

    update

    wb1.Sheets("Setlist").Range("D2").Copy

    wb2.Sheets(shtname).Range("E2").Rows("1:27").Insert Shift:=xlDown

   wb2.Sheets(shtname).Columns().AutoFit

Err_Execute:
    If Err.Number = 0 Then MsgBox "All have been copied!" Else _
    MsgBox Err.Description

End Sub

Sub update()   

    dataform.Range("Reading").Copy
    dataform.Range("PreviousReading, Usage").PasteSpecial

    dataform.Range("Usage").Copy
    wb2.Sheets(shtname).Range("G2").Insert Shift:=xlDown
End Sub
 

(Есть еще коды, но я просто добавляю половину, извините за путаницу. Если есть полезные ссылки, которые могут помочь. Очень признателен.)