Создание цикла для выполнения одного и того же кода несколько раз

Question

Мне нужна помощь, чтобы создать цикл из моего кода

Код имеет две основные функции:

1. Копирование и вставка общих данных в другую рабочую книгу
2. Скопируйте и вставьте данные сотрудника в другую рабочую книгу

Я хочу сделать цикл моего кода (код показан ниже). Я могу сделать этот код 15 раз, и он будет работать, но я думаю, что цикл лучше. У меня нет опыта работы с петлями.

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

Рабочая книга, которую нужно открыть, находится в диапазоне F82: F96, поэтому сначала F82, затем F83 ... и т. Д., Пока она не достигнет F96, а затем код должен остановиться.

Общие данные всегда находятся в строках 15 и 16.

Данные о сотруднике находятся в той же строке, что и рабочая книга, которую необходимо открыть. Строка после строки должна быть скопирована и вставлена ​​в другую книгу. Так, например (G82: DI82).

Что у меня есть

Я создал код, который работает на 1 сотрудника в ячейке (F82). Приведенный ниже код открывает книгу этого сотрудника, затем копирует общие данные, затем находит нужный столбец и строку для вставки. Затем я вставляю данные, затем они возвращаются в основную рабочую книгу и копируют данные, принадлежащие сотруднику (G82: DI82), и вставляют эти данные в другую рабочую книгу. Затем он сохраняет закрытые открытые книги. Основная рабочая книга остается открытой.

Что я ожидаю

Мне нужен цикл для повторения кода. Итак, сначала сотрудник, который находится в (F82), затем сотрудник, который в (F83) и так далее.

код:

Private Sub mUpdate_Click()

Dim General As Range
Dim employe1hours As Range
Dim employepaste As Range
Dim employepastehours As Range
Dim CurrentweekColumn As Range
Dim Currentweekpaste As Range

Dim employepath As String
Dim employe1 As String
Dim rowstr As String
Dim Foundrow As Range
Dim Currentweek As String


employepath = "J:\Planning\Medewerkers\"
Currentweek = Range("B7").Value
employe1 = Range("F82").Value
rowstr = Range("A2").Value

    With ActiveWorkbook.Sheets("Planning").Range("14:14")
    Set CurrentweekColumn = .find(what:=Currentweek, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
    End With

        Set General = ActiveWorkbook.Sheets("Planning").Range(Cells(15, CurrentweekColumn.Column), Cells(16, CurrentweekColumn.Offset(0, 106).Column))
        General.Copy

        Workbooks.Open (employepath & employe1 & ".xlsm")

            With ActiveWorkbook.Sheets("Blad1").Range("14:14")
            Set Currentweekpaste = .find(what:=Currentweek, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            End With

            With ActiveWorkbook.Sheets("Blad1").Range("A:A")
            Set Foundrow = .find(what:=rowstr, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            End With

            Set employepaste = ActiveWorkbook.Sheets("Blad1").Range(Cells(Foundrow.Row, Currentweekpaste.Column).Address)
            employepaste.PasteSpecial Paste:=xlPasteFormats
            employepaste.PasteSpecial Paste:=xlPasteValues

                Workbooks(rowstr & ".xlsm").Activate
                Set employe1hours = ActiveWorkbook.Sheets("Planning").Range(Cells(82, CurrentweekColumn.Column), Cells(82, CurrentweekColumn.Offset(0, 106).Column))
                employe1hours.Copy

                Workbooks(employe1 & ".xlsm").Activate
                Set employepastehours = ActiveWorkbook.Sheets("Blad1").Range(Cells(Foundrow.Offset(2, 0).Row, Currentweekpaste.Column).Address)
                employepastehours.PasteSpecial Paste:=xlPasteValues

                ActiveWorkbook.Save
                ActiveWorkbook.Close

Answer 1

Поскольку мы не можем сделать всю работу за вас, это должно дать вам представление о том, как может выглядеть цикл:

Option Explicit

Public Sub MyUpdateProcedure()
    Dim Employees As Range 'define the range of employees
    Set Employees = ThisWorkbook.Worksheets("SheetName").Range("F82:F96")

    Dim CurrentWorkbook As Workbook
    Const EmployePath As String = "J:\Planning\Medewerkers\"


    Dim Employe As Range
    For Each Employe In Employees 'loop throug all employees
        'open the workbook
        Set CurrentWorkbook = Workbooks.Open(EmployePath & Employe.Value & ".xlsm")

        With CurrentWorkbook.Sheets("Blad1")
            'your stuff here
        End With


        'your other stuff here

        'save and close workbook
        CurrentWorkbook.Close SaveChanges:=True
    Next Employe
End Sub

Обратите внимание, что вы должны избегать ActiveWorkbook и вместо этого установить открытую рабочую книгу в переменную, такую ​​как Set CurrentWorkbook = Workbooks.Open, которую вы легко сможете использовать.

Также убедитесь, что у всех ваших Range(…) объектов указана рабочая книга / рабочий лист, например ThisWorkbook.Worksheets("SheetName").Range(…), в противном случае Excel угадает, какой лист вы имеете в виду.

---

Также следует помнить об ошибках:

Set CurrentWorkbook = Workbooks.Open(EmployePath & Employe.Value & ".xlsm")

выдаст ошибку, если книга не существует, поэтому вы можете ее перехватить:

    'open the workbook
    Set CurrentWorkbook = Nothing 'initialize since we are in a loop!
    On Error Resume Next 'next line throws an error if file not found so catch it
    Set CurrentWorkbook = Workbooks.Open(EmployePath & Employe.Value & ".xlsm")
    On Error GoTo 0 'always re-activate error reporting!

    If Not CurrentWorkbook Is Nothing Then
        'file for employee was found
        With CurrentWorkbook.Sheets("Blad1")
            'your stuff here
        End With


        'your other stuff here

        'save and close workbook
        CurrentWorkbook.Close SaveChanges:=True
    Else
        'file for employee was not found
    End If