我想知道我的代码是否可以简化

Question

我创建了一些代码，使用户可以用4个表填写excelsheet。通过按一个按钮，它将表数据复制到另一个工作簿。它必须找到填充的最后一行，并复制下面的数据。有些单元格不会被填充，所以我使用.Filldown来填充空单元格。为了使.Filldown正常工作，我不得不对表中的行进行计数。

一切正常，但是我是VBA的新手，所以我想知道我的代码是否可以简化。看起来很多代码。

Private Sub CommandButton5_Click()

Dim PassWord As Variant

PassWord = InputBox("Wachtwoord?")
'PassWord = "Something"
If PassWord = "Something" Then

Dim nT1 As Integer
Dim nT2 As Integer
Dim nT3 As Integer
Dim nT4 As Integer


If Sheets("Variabelen").Range("H2") = 0 Then

Set Z = ActiveWorkbook.Sheets(1)
Set T1 = ActiveSheet.ListObjects("Tabel1").DataBodyRange
Set T1C = ActiveSheet.ListObjects("Tabel1")

Set T2 = ActiveSheet.ListObjects("Tabel2").DataBodyRange
Set T2C = ActiveSheet.ListObjects("Tabel2")

Set T3 = ActiveSheet.ListObjects("Tabel3").DataBodyRange
Set T3C = ActiveSheet.ListObjects("Tabel3")

Set T4 = ActiveSheet.ListObjects("Tabel4").DataBodyRange
Set T4C = ActiveSheet.ListObjects("Tabel4")

nT1 = T1C.Range.Rows.Count - 1
nT2 = T2C.Range.Rows.Count - 1
nT3 = T3C.Range.Rows.Count - 1
nT4 = T4C.Range.Rows.Count - 1

'Test_ verwijderen als bestand actief wordt
Set Y = Workbooks.Open("\\Somewhere\Test_Masterbestand Afdeling.xlsx")

'Huidige medewerker in opleiding (T1)

    lRow = Y.Worksheets("Data").Cells(Y.Worksheets("Data").Rows.Count, 1).End(xlUp).Row
    lRow = lRow + 1
    T1.Copy
    Y.Worksheets("Data").Range("A" & lRow).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False

    Y.Sheets("Data").Range("I" & lRow).Value = "Huidige medewerker in opleiding"
    Y.Sheets("Data").Range("J" & lRow).Value = Z.Range("C3").Value
    Y.Sheets("Data").Range("K" & lRow).Value = Z.Range("C4").Value
    Y.Sheets("Data").Range("L" & lRow).Value = Z.Range("C6").Value

        Dim LastRowA As Long
        Dim LastRowB As Long
        Dim LastRowC As Long
        Dim LastRowD As Long
        Dim LastRowE As Long

        LastRowA = ActiveSheet.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowB = ActiveSheet.Range("I:I").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowC = ActiveSheet.Range("J:J").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowD = ActiveSheet.Range("K:K").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowE = ActiveSheet.Range("L:L").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        CopyrangeB = "I" & LastRowB & ":" & "I" & LastRowA
        CopyrangeC = "J" & LastRowC & ":" & "J" & LastRowA
        CopyrangeD = "K" & LastRowD & ":" & "K" & LastRowA
        CopyrangeE = "L" & LastRowE & ":" & "L" & LastRowA

        If nT1 > 1 Then

            ActiveSheet.Range(CopyrangeB).FillDown
            ActiveSheet.Range(CopyrangeC).FillDown
            ActiveSheet.Range(CopyrangeD).FillDown
            ActiveSheet.Range(CopyrangeE).FillDown

        End If

'Nieuwe instroom in opleiding (T2)

    lRow = Y.Worksheets("Data").Cells(Y.Worksheets("Data").Rows.Count, 1).End(xlUp).Row
    lRow = lRow + 1
    T2.Copy
    Y.Worksheets("Data").Range("A" & lRow).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Y.Sheets("Data").Range("I" & lRow).Value = "Nieuwe instroom in opleiding"
    Y.Sheets("Data").Range("J" & lRow).Value = Z.Range("C3").Value
    Y.Sheets("Data").Range("K" & lRow).Value = Z.Range("C4").Value
    Y.Sheets("Data").Range("L" & lRow).Value = Z.Range("C6").Value

        Dim LastRowF As Long
        Dim LastRowG As Long
        Dim LastRowH As Long
        Dim LastRowI As Long
        Dim LastRowJ As Long

        LastRowF = ActiveSheet.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowG = ActiveSheet.Range("I:I").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowH = ActiveSheet.Range("J:J").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowI = ActiveSheet.Range("K:K").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowJ = ActiveSheet.Range("L:L").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        CopyrangeG = "I" & LastRowG & ":" & "I" & LastRowF
        CopyrangeH = "J" & LastRowH & ":" & "J" & LastRowF
        CopyrangeI = "K" & LastRowI & ":" & "K" & LastRowF
        CopyrangeJ = "L" & LastRowJ & ":" & "L" & LastRowF

        If nT2 > 1 Then

            ActiveSheet.Range(CopyrangeG).FillDown
            ActiveSheet.Range(CopyrangeH).FillDown
            ActiveSheet.Range(CopyrangeI).FillDown
            ActiveSheet.Range(CopyrangeJ).FillDown

        End If

'Afdelingspecifiek(T3)


    lRow = Y.Worksheets("Data").Cells(Y.Worksheets("Data").Rows.Count, 1).End(xlUp).Row
    lRow = lRow + 1
    T3.Copy
    Y.Worksheets("Data").Range("A" & lRow).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Y.Sheets("Data").Range("I" & lRow).Value = "Afdelingspecifiek"
    Y.Sheets("Data").Range("J" & lRow).Value = Z.Range("C3").Value
    Y.Sheets("Data").Range("K" & lRow).Value = Z.Range("C4").Value
    Y.Sheets("Data").Range("L" & lRow).Value = Z.Range("C6").Value

        Dim LastRowK As Long
        Dim LastRowL As Long
        Dim LastRowM As Long
        Dim LastRowN As Long
        Dim LastRowO As Long

        LastRowK = ActiveSheet.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowL = ActiveSheet.Range("I:I").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowM = ActiveSheet.Range("J:J").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowN = ActiveSheet.Range("K:K").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowO = ActiveSheet.Range("L:L").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        CopyrangeL = "I" & LastRowL & ":" & "I" & LastRowK
        CopyrangeM = "J" & LastRowM & ":" & "J" & LastRowK
        CopyrangeN = "K" & LastRowN & ":" & "K" & LastRowK
        CopyrangeO = "L" & LastRowO & ":" & "L" & LastRowK

        If nT3 > 1 Then

            ActiveSheet.Range(CopyrangeL).FillDown
            ActiveSheet.Range(CopyrangeM).FillDown
            ActiveSheet.Range(CopyrangeN).FillDown
            ActiveSheet.Range(CopyrangeO).FillDown

        End If

'Individueel (T4)

    lRow = Y.Worksheets("Data").Cells(Y.Worksheets("Data").Rows.Count, 1).End(xlUp).Row
    lRow = lRow + 1
    T4.Copy
    Y.Worksheets("Data").Range("A" & lRow).PasteSpecial Paste:=xlPasteValues
    Y.Sheets("Data").Range("I" & lRow).Value = "Individueel"
    Y.Sheets("Data").Range("J" & lRow).Value = Z.Range("C3").Value
    Y.Sheets("Data").Range("K" & lRow).Value = Z.Range("C4").Value
    Y.Sheets("Data").Range("L" & lRow).Value = Z.Range("C6").Value
    Application.CutCopyMode = False

        Dim LastRowP As Long
        Dim LastRowQ As Long
        Dim LastRowR As Long
        Dim LastRowS As Long
        Dim LastRowT As Long

        LastRowP = ActiveSheet.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowQ = ActiveSheet.Range("I:I").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowR = ActiveSheet.Range("J:J").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowS = ActiveSheet.Range("K:K").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowT = ActiveSheet.Range("L:L").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastRowU = ActiveSheet.Range("N:N").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        CopyrangeQ = "I" & LastRowQ & ":" & "I" & LastRowP
        CopyrangeR = "J" & LastRowR & ":" & "J" & LastRowP
        CopyrangeS = "K" & LastRowS & ":" & "K" & LastRowP
        CopyrangeT = "L" & LastRowT & ":" & "L" & LastRowP
        'Formule in Kolom M
        CopyrangeU = "N" & LastRowU & ":" & "N" & LastRowP

        If nT4 > 1 Then

            ActiveSheet.Range(CopyrangeQ).FillDown
            ActiveSheet.Range(CopyrangeR).FillDown
            ActiveSheet.Range(CopyrangeS).FillDown
            ActiveSheet.Range(CopyrangeT).FillDown
            ActiveSheet.Range(CopyrangeU).FillDown

        End If

   ' Y.Close (True)

'Quote weghalen bij opleveren
'Sheets("Variabelen").Range("H2").Value = Sheets("Variabelen").Range("H2").Value + 1
Else
MsgBox ("Niet nog een keer Sylvia!!!!")
End If

Else
'Do nothing
End If
End Sub

没有