Ошибка времени выполнения ‘9’, подстрочный индекс из диапазона ошибок

Я новичок в программировании Excel и VBA, я сделал лист посещаемости и хочу скопировать данные с одного листа на другой ( месяц мудрый), нажав кнопку.

Я получаю ошибку в следующей строке

lastrow1 = Sheets(“Sheet14”).Range(“A” & Rows.Count).End(xlUp).Row

Мой код

Sub Button2_Click()

    Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
    Dim myname As String
    lastrow1 = Sheets(“Sheet14”).Range(“A” & Rows.Count).End(xlUp).Row

    For i = 7 To lastrow1
        myname = Sheets(“Sheet14”).Cells(i, “A”).Value

        Sheets(“sheet2”).Activate
        lastrow2 = Sheets(“sheet2”).Range(“A” & Rows.Count).End(xlUp).Row

        For j = 7 To lastrow2

            If Sheets(“sheet2”).Cells(j, “A”).Value = myname Then
                Sheets(“Sheet14”).Activate
                Sheets(“Sheet14”).Range(Cells(i, “D”), Cells(i, “AH”)).Copy
                Sheets(“sheet2”).Activate
                Sheets(“sheet2”).Range(Cells(j, “D”), Cells(j, “AH”)).Select
                ActiveSheet.Paste
            End If

        Next j
        Application.CutCopyMode = False
    Next i
    Sheets(“Sheet14”).Activate
    Sheets(“Sheet14”).Range(“D7”).Select
End Sub

1 ответ

  1. Ваш код имел неправильный тип, а "не .

    Лучше держаться подальше отActivate, Selectи ActiveSheetи использовать ссылаться лист и диапазоны вместо этого (это также будет быстрее).

    Попробуйте код ниже, он будет делать то же самое, только немного быстрее (и надежнее не в зависимости от ActiveSheet.

    измененный код

    Sub Button2_Click()
    
    Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
    Dim myname As String
    
    With Sheets("Sheet14")
        lastrow1 = .Range("A" & .Rows.Count).End(xlUp).Row
    
        ' take the line below outside the For loop, there is no need to get the last row evey time 
        lastrow2 = Sheets("sheet2").Range("A" & Sheets("sheet2").Rows.Count).End(xlUp).Row        
        For i = 7 To lastrow1
            myname = .Range("A" & i).Value
    
            For j = 7 To lastrow2
                If Sheets("sheet2").Range("A" & j).Value = myname Then
                    .Range("D" & i & ":AH" & i).Copy Destination:=Sheets("sheet2").Range(Range("D" & j & ":AH" & j))
                End If
            Next j
            Application.CutCopyMode = False
        Next i
    End With
    
    End Sub
    

    Примечание: если данные в sheet2 и sheet14 уникальны (появляются только один раз во всем листе), рассмотрите возможность использования Matchфункции, это сэкономит вам 1 Forцикл.