Ошибка времени выполнения «1004»: ошибка приложения или объекта - PullRequest
1 голос
/ 10 июля 2019

Я пытаюсь скопировать и вставить данные с одного листа на другой из выбранного диапазона, введенного пользователем.TxtDateStart принимает дату начала, а TxtDateEnd принимает дату окончания.Затем он будет копировать и вставлять данные из диапазона дат на новый лист.Когда я запускаю код в форме, он работает, но у меня есть форма, вызывающая модуль.Это где я получаю ошибку во время выполнения.Я не эксперт в VBA, помощь будет оценена.Лист, на котором находятся данные, называется Unit2Data, а лист, на который я хочу вставить данные, - это Graphing Sheet.

Ошибка в этой строке

Sheets("Unit2Data").Range(Cells(i, 1), Cells(i, 73)).Select
Sub Unit2Data()

Dim lrow As Long, i As Long, x As Date, y As Date, erow As Long

x = TxtDateStart
y = TxtDateEnd

'Find the Last Row of Sheet1
lrow = Sheets("Unit2Data").Range("A" & Rows.Count).End(xlUp).Row

'start counting from row 3 to last row
For i = 4 To lrow
' Date value converted as numeric value by multiplying with number 1
If Cells(i, 1) * 1 >= x * 1 Then
If Cells(i, 1) * 1 <= y * 1 Then

'If above conditions matched then select the matched range/ entire column

Sheets("Unit2Data").Range(Cells(i, 1), Cells(i, 73)).Select

'copy the selected row
Selection.Copy

'to make sheet2 active where we want to paste the selected row
Sheets("Graphing Sheet").Activate


'to find the empty row from where the copied row of sheet1 to be pasted in sheet2
erow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

'to activate or select the empty row of sheet2
ActiveSheet.Cells(erow, 1).Select

'paste the copied data
ActiveSheet.Paste

'to deselect the copy and selected mode
Application.CutCopyMode = False

'for above the if we need 3 end if to close if conditions
End If
End If
'to activate sheet1 for searching the matched data
Sheets("Unit2Data").Activate
'continue for look until above matched found
Next i
End Sub
Date              Data 
01/01/2019          2
02/02/2019          3

1 Ответ

2 голосов
/ 10 июля 2019

Сначала вы должны избегать использования Select в VBA .Почти всегда есть лучшие способы добиться того, что вы используете для Select.

В вашем случае, и в отношении только конкретной ошибки / вопроса , удалите вызывающую ошибкуи следующую строку (Selection.Copy) и замените на это:

With Sheets("Unit2Data")
    .Range(.Cells(i, 1), .Cells(i, 73)).Copy
End With

Переписать весь код, чтобы избежать использования Select:

Sub Unit2Data()
Dim lrow As Long, i As Long, x As Date, y As Date, erow As Long

x = TxtDateStart
y = TxtDateEnd

With Sheets("Unit2Data")
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = 4 To lrow
        If .Cells(i, 1) * 1 >= x * 1 Then
            If .Cells(i, 1) * 1 <= y * 1 Then
                With Sheets("Graphing Sheet")
                    erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                End With
                .Range(.Cells(i, 1), .Cells(i, 73)).Copy _
                    Destination:= Sheets("Graphing Sheet").Cells(erow, 1)
            End If
        End If
    Next i
End With

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...