Как создать шаблоны, включающие в себя пользовательские формы Excel?

Question

Я пытаюсь оптимизировать рабочий процесс, автоматизируя создание шаблонов. Я довольно неопытен, используя VBA, как видно из избыточности в коде ниже.

В идеале я хотел бы:

• Активировать файлы в определенной папке и извлечь данные в существующий шаблон
• Переместить файлы в папку «Завершено» после извлечения данных
• Включение функции пользовательской формы для добавления двух записей в указанный диапазон в двух столбцах шаблона
• Сохранить шаблон в «созданной» папке -Обеспечить оригинальность файла шаблона

На данный момент я только переименовываю файлы, когда просматриваю их, но в коде VBA для каждого файла необходимо внести много изменений.

Sub PltgSheet()


Dim sourceColumn As Range, targetColumn As Range

Workbooks.Open ("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Datafile1.xlsx")
Workbooks.Open ("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Template.xlsx")


Set sourceColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Datafile1.xlsx").Worksheets(1).Range("A5:A96")
Set targetColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Template.xlsx").Worksheets(1).Range("F4:F95")

sourceColumn.Copy
targetColumn.PasteSpecial xlPasteValues
Application.CutCopyMode = False

Set sourceColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Datafile1.xlsx").Worksheets(1).Range("B5:B96")
Set targetColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Template.xlsx").Worksheets(1).Range("G4:G95")

sourceColumn.Copy
targetColumn.PasteSpecial xlPasteValues
Application.CutCopyMode = False

 Set sourceColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Datafile1.xlsx").Worksheets(1).Range("C5:C96")
Set targetColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Template.xlsx").Worksheets(1).Range("H4:H95")

sourceColumn.Copy
targetColumn.PasteSpecial xlPasteValues
Application.CutCopyMode = False

Set sourceColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Datafile1.xlsx").Worksheets(1).Range("H5:H96")
Set targetColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Template.xlsx").Worksheets(1).Range("I4:I95")

sourceColumn.Copy
targetColumn.PasteSpecial xlPasteValues
Application.CutCopyMode = False

Set sourceColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Datafile1.xlsx").Worksheets(1).Range("I5:I96")
Set targetColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Template.xlsx").Worksheets(1).Range(" J4:J95")

sourceColumn.Copy
targetColumn.PasteSpecial xlPasteValues
Application.CutCopyMode = False

Set sourceColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Datafile1.xlsx").Worksheets(1).Range("J5:J96")
Set targetColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Template.xlsx").Worksheets(1).Range(" K4:K95")

sourceColumn.Copy
targetColumn.PasteSpecial xlPasteValues
Application.CutCopyMode = False


Set sourceColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Datafile1.xlsx").Worksheets(1).Range("K5:K96")
Set targetColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Template.xlsx").Worksheets(1).Range(" L4:L95")

sourceColumn.Copy
targetColumn.PasteSpecial xlPasteValues
Application.CutCopyMode = False


Set sourceColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Datafile1.xlsx").Worksheets(1).Range("L5:L96")
Set targetColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Template.xlsx").Worksheets(1).Range(" M4:M95")

sourceColumn.Copy
targetColumn.PasteSpecial xlPasteValues
Application.CutCopyMode = False

Set sourceColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Datafile1.xlsx").Worksheets(1).Range("M5:M96")
Set targetColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Template.xlsx").Worksheets(1).Range(" N4:N95")

sourceColumn.Copy
targetColumn.PasteSpecial xlPasteValues
Application.CutCopyMode = False

Set sourceColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Datafile1.xlsx").Worksheets(1).Range("N5:N96")
Set targetColumn = Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Template.xlsx").Worksheets(1).Range(" O4:O95")

sourceColumn.Copy
targetColumn.PasteSpecial xlPasteValues
Application.CutCopyMode = False


Workbooks("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Template.xlsx").Worksheets(1).Activate
Range("C4:C95") = "2405" 'this data changes periodically and would be best to enter manually
Range("D4:D95") = "DIS"  'this data changes periodically and would be best to enter manually

End Sub

Answer 1

Вот как я бы уменьшил избыточность - ваши диапазоны очень похожи, так что вы можете просто менять их в цикле каждый раз. Я также добавил InputBox s в конце, чтобы вы могли вручную ввести эти два значения вместо записи в коде.

Option Explicit
Sub PltgSheet()

Dim sourcebook As Workbook, targetbook As Workbook
Dim sourcesheet As Worksheet, targetsheet As Worksheet
Dim i As Long, j As Long

Set sourcebook = Workbooks.Open("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Datafile1.xlsx")
Set targetbook = Workbooks.Open("\\in-file\users\ver\Desktop\Folder\Datafoldertoextract\Template.xlsx")

Set sourcesheet = sourcebook.Worksheets(1)
Set targetsheet = targetbook.Worksheets(1)

i = 1

For j = 6 To 15

    targetsheet.Range(targetsheet.Cells(4, j), targetsheet.Cells(95, j)).Value = _
    sourcesheet.Range(sourcesheet.Cells(5, i), sourcesheet.Cells(96, i)).Value

    If i = 3 Then
        i = i + 5
    Else
        i = i + 1
    End If

Next j

targetbook.Range("C4:C95") = InputBox("Enter value one") 'This is where you had 2405
targetbook.Range("D4:D95") = InputBox("Enter value two") 'This is where you had DIS

End Sub