3 вещи, которые я сразу вижу, которые могут вызвать проблемы и должны быть исправлены:
Если вы Dim lastrow, erow As Integer только erow - Integer, но lastrow - Variant , В VBA необходимо указать тип для каждой переменной , или по умолчанию это Variant. Кроме того, в Excel имеется больше строк, чем может обработать Integer, поэтому вам нужно использовать Long:
Dim lastrow As Long, erow As Long.
Далее я рекомендую всегда использовать Long , поскольку использование * не дает никаких преимуществ Integer в VB.
Прекратить использование .Activate и .Select. Это очень плохая практика и приводит ко многим ошибкам. См. Как избежать использования Select в Excel VBA . Всегда обращайтесь непосредственно к своей книге и листу. Убедитесь, что все Cells, Range, Rows и Columns имеют ссылку на лист. Некоторые из них без Cells(I, 3) следует изменить на что-то вроде Sheets("Sheet1").Cells(I, 3) или при использовании блока With на .Cells(I, 3).
Вы смешиваете Sheets и Worksheets во всем коде. Убедитесь, что вы знаете разницу. Все листы являются листами, но листы могут быть листом или диаграммой или…
Поэтому убедитесь, что вы используете Worksheets, так как листы будут намного чище.
Рекомендую также не повторять Worksheets("Sheet1") все время. Если имя вашего листа изменится с Sheet1 на что-то полезное, например MyRawData, его нужно менять везде. Лучше определить переменную Dim wsData As Worksheet и Set wsData = ThisWorkbook.Worksheets("Sheet1"), тогда вы можете использовать ее как wsData.Range("A1")…
Попытайтесь исправить это и проверить, не застряли ли вы в коде. Если это не решает ваши проблемы, отредактируйте ваш код в вопросе на обновленный. Попытайтесь выяснить, какая строка вызывает проблему, и скажите нам, какая это строка.
Чистая версия вашего кода может выглядеть так:
Option Explicit 'make sure you use it in every module as first line to force proper variable declaration
Public Sub CopyColumn()
Dim wsData As Worksheet 'name your sheet only once and set a reference using a variable
Set wsData = ThisWorkbook.Worksheets("Sheet1")
With wsData 'Clear the existing sheet rows
Dim LastRow As Long
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'the other 2 ClearContents are already covered by this one and therefore are not needed
.Range(.Cells(2, 3), .Cells(LastRow, 1)).ClearContents
End With
Dim Assets As Variant
Assets = Array("Water 2016", "Water 2017", "Water 2018", "Water 2019", "Water 2020")
Dim Asset As Variant
For Each Asset In Assets 'copy each sheet's 2 col data to "sheet1" into 1 long column
With ThisWorkbook.Worksheets(Asset)
LastRow = Application.Max(4, .Cells(.Rows.Count, "A").End(xlUp).Row)
.Range(.Cells(2, 1), .Cells(LastRow, 1)).Copy 'date
Dim eRow As Long
eRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
wsData.Range("A" & eRow).PasteSpecial xlPasteValues
.Range(.Cells(2, 4), .Cells(LastRow, 4)).Copy 'data
eRow = wsData.Cells(wsData.Rows.Count, 2).End(xlUp).Offset(1, 0).Row
wsData.Range("B" & eRow).PasteSpecial xlPasteValues
End With
Next Asset
'goto sheet1 and put day name into column 4
LastRow = wsData.Cells(wsData.Rows.Count, 2).End(xlUp).Row
Dim i As Long
For i = 2 To LastRow 'DeS' hangs in this loop
wsData.Cells(i, 3).Value = Format$(wsData.Cells(i, 1), "dddd")
Next i
'jump to the last row
wsData.Activate
wsData.Cells(LastRow, 4).Select 'not needed if you don't want explicitly the user to see this
MsgBox "Copied" & vbTab & LastRow & vbTab & "Rows", vbInformation, "Copy Rows"
End Sub
Обратите внимание, что я не сделал копаться в процессе того, что делает код. Я только что проверил стиль кодирования и исправил синтаксис, где вещи, очевидно, могли бы go ошибаться.
Чем ближе вы придерживаетесь хорошего форматирования и хорошего стиля кодирования, тем меньше ошибок вы получите. Даже если это выглядит иногда немного больше работы, в конце вы сэкономите много времени, не пытаясь найти причину странных проблем.
Дальнейшие мысли
Эта строка
Assets = Array("Water 2016", "Water 2017", "Water 2018", "Water 2019", "Water 2020")
Похоже, вам нужно будет снова покопаться в коде 2021 и добавить "Water 2021", потому что ваш код перестал работать.
Избегайте написания кода, который нужно корректировать каждый год. Я бы рекомендовал l oop - всем рабочим листам и проверить, совпадает ли их имя с "Water ####", чтобы выполнить код для них:
Dim Asset As Worksheet
For Each Asset In ThisWorkbook.Worksheets
If Asset.Name Like "Water ####" Then
'your code here …
End If
End If
Это будет применяться к каждому лист, который называется "Water ####"