Я получаю ошибку времени выполнения 1004 во время работы vba

Question

Я действительно знал, что преуспел, и у меня проблемы. Я пытаюсь создать лист посещаемости, который по соображениям безопасности периодически обновляется в течение дня. на листе со всеми возможными именами у меня есть столбец для разных компаний, имена, лагерь, комната и на месте. я написал свой код, чтобы, если человек находится на сайте, чем 1, идет в столбце на сайте и 0, если они находятся вне сайта. когда появляется 1, я хочу, чтобы их имя и всякая другая информация передавались на лист посещаемости, чтобы отображались только имена, которые находятся на сайте. если они на месте, я хочу, чтобы пробел оставался пустым. у меня есть две проблемы с моим кодом:

Sub onsite() 

    x = 3 'start at row 3 


    'start the loop 
    Do While Cells(x, 6) <> "" 

     'look for data with '1' 
     If Cells(x, 6) = "1" Then 

     'copy the row if it contains '1' 
     Worksheets("Sheet1").Rows(x).Copy 

     'go to main ERP. activate it 
     Worksheets("Sheet2").Activate 

     **erow = Sheet2.Cells(Rows.Count, 6).End(x1Up).Offset(1, 0).Row** 
     'paste data 

     '**ERROR OCCURS HERE** 
     ActiveSheet.Paste Destination:=Worksheets("Sheet2").Rows(erow) 

     End If 

     'go to all names and activate 
     Worksheets("AllNames").Activate 

     'loop through the other rows 
     x = x + 1 

    Loop 

End Sub 

Первая проблема в том, что после того, как я достичь смелую линию я получаю сообщение об ошибке «1004» сообщение и код перестает работать

Другая проблема состоит в том, что я не знаю, как изменить «erow =» в код, который пропускает строку, когда у человека есть 0 в своей колонке на сайте

, пожалуйста, помогите !!

Answer 1

This MS Knowledgebase article описывает причину ошибки и обходной путь.

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

Answer 2

Sub onsite() 
    Dim x as long, erow as Long 
    Dim shtSrc as Worksheet, shtDest as worksheet 

    Set shtSrc = Worksheets("Sheet1") 
    Set shtDest = Worksheets("Sheet2") 
    erow = shtDest.Cells(rows.count, 6).End(x1Up).Row+1 

    x = 3  

    Do While shtSrc.Cells(x, 6) <> "" 

     If shtSrc.Cells(x, 6) = "1" Then 

      shtSrc.Rows(x).Copy shtDest.cells(erow,1) 
      erow = erow+1 

     End If 
     x = x + 1 

    Loop 

End Sub