"SkipBlanks" используется, когда у вас есть диапазон, который вы хотите скопировать, и когда вы вставляете в новое место, вы не хотите, чтобы ваши предыдущие значения были перезаписаны пустым / пустым данные. Тем не менее, это не исключит каких-либо клеток из вашего диапазона. Поэтому вы все равно получите «пустые» строки.
1A - Вы можете строить диапазоны в VBA следующим образом:
Range("S73:S128") -> Range(Cells(S73), Cells(S128)) ->
Range(Cells(row number, column number), Cells(row number, column number)) ->
Range(Cells(73, 19), Cells(128, 19))
2A - Мы можем ссылаться на разные рабочие книги, например:
Dim Wkb As Workbook
Set Wkb = ThisWorkbook
Dim MainSheet As Worksheet
Set MainSheet = Wkb.Worksheets("MAIN")
Dim ArchiveSheet As Worksheet
Set ArchiveSheet = Wkb.Worksheets("ARCHIVE")
Если мы объединяем эти два, 1А и 2А, мы можем ссылаться на разные листы в одной и той же книге.
MainSheet.Range(MainSheet.Cells(73, 19), MainSheet.Cells(128, 19)) -> диапазон «S73:S128» для листа «Основной»
И то же самое можно сделать для Архива:
ArchiveSheet.Range(ArchiveSheet.Cells(73, 19), ArchiveSheet.Cells(128, 19)) -> диапазон «S73:S128» для листа «Архив»
Этот метод полезен, когда мы хотим скопировать и вставить на лист.
Последняя строка может быть переопределена как:
Range("A65536").End(xlUp)(2).Select -> Archivelrow = Worksheets("ARCHIVE").Cells(Rows.Count, 2).End(xlUp).Row, где lrow будет переменной, которую мы можем использовать для ссылки на последнюю строку.
3A - Мы можем циклически проходить через каждую ячейку в столбце и выбирать только интересующие нас ячейки, используя "FOR loop". Это сделает ваш диапазон динамичным. Если строки добавляются или удаляются, мы только перебираем больше или меньше строк.
For i = 6 To 51 'This would tell us, loop from row 6 to 51.
'For each loop, do something
Cells(i,1).Value ' This will take the value for Cell in Column A, at row i. Remember point 1A, where we wrote cells!
Next i
Следующий шаг, мы не хотим копировать все .. В столбце A мы не хотим копировать ячейки с заголовками, такими как: «Дата», «Понедельник» и т. Д.
4А - Если заявление поможет нам здесь. Мы можем установить условие (оператор TRUE / FALSE)
If Cells(i,1).Value = "Blue" Or Cells(i,1).Value = "Red" Then
'"Do something" if the current cell in loop has value "Blue" or "Red"
Else
'"Don't do anything" if the current cell in loop don't contain value "Blue" or "Red"
End if
Если мы скомбинируем эти два, 3A и 4A, мы сможем пройти через каждую ячейку и выполнять только в том случае, если значение ячейки удовлетворяет определенному условию.
В вашем случае у нас будет:
For i = 6 To Mainlrow 'loop from row 6 to last row in column A and F
' Check if Column F = TOTAL, Check if Column A = DATE, Check if Column B has empty cells, Check Column A for last row that contain word TOTAL
If MainSheet.Cells(i, 6).Value = "TOTAL" Or MainSheet.Cells(i, 1).Value = "DATE" Or _
MainSheet.Cells(i, 2).Value = "" Or MainSheet.Cells(i, 1).Value Like "*TOTAL*" Then
'Do nothing
Else
MainSheet.Range(MainSheet.Cells(i, 1), MainSheet.Cells(i, 11)).Copy _
ArchiveSheet.Range(ArchiveSheet.Cells(Archivelrow, 1), ArchiveSheet.Cells(Archivelrow, 11)) 'Copy range from Sheet "Main" to Sheet "Archive"
Application.CutCopyMode = False 'Remove selection
ArchiveSheet.Range(ArchiveSheet.Cells(Archivelrow, 1), ArchiveSheet.Cells(Archivelrow, 11)).Columns.AutoFit 'Autofit columns
Archivelrow = Archivelrow + 1 'Add one to lastrow
End If
Next i
Это сделает ваш полный код ( updated ):
Sub SaveToArchive2()
Dim response As String
response = MsgBox("Are You Sure?", vbYesNo)
If response = vbNo Then
MsgBox ("Goodbye!")
Exit Sub
End If
Dim i As Long
Dim Mainlrow As Long
Dim Archivelrow As Long
Dim Wkb As Workbook
Set Wkb = ThisWorkbook
Dim MainSheet As Worksheet
Set MainSheet = Wkb.Worksheets("MAIN")
Dim ArchiveSheet As Worksheet
Set ArchiveSheet = Wkb.Worksheets("ARCHIVE")
Mainlrow = MainSheet.Cells(Rows.Count, 7).End(xlUp).Row 'take the last row by looking in column G
Archivelrow = ArchiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 'take the last row by looking in column F
For i = 6 To Mainlrow 'loop from row 6 to last row in column A and F
' Check if Column F = TOTAL, Check if Column A = DATE, Check if Column B has empty cells, Check Column A for last row that contain word TOTAL
If MainSheet.Cells(i, 6).Value = "TOTAL" Or MainSheet.Cells(i, 1).Value = "DATE" Or _
MainSheet.Cells(i, 2).Value = "" Or MainSheet.Cells(i, 1).Value Like "*TOTAL*" Then
'Do nothing
Else
With MainSheet.Range(MainSheet.Cells(i, 1), MainSheet.Cells(i, 11))
ArchiveSheet.Range(ArchiveSheet.Cells(Archivelrow, 1), ArchiveSheet.Cells(Archivelrow, 11)).Value = .Value 'Copy range from Sheet "Main" to Sheet "Archive"
End With
Application.CutCopyMode = False 'Remove selection
ArchiveSheet.Range(ArchiveSheet.Cells(Archivelrow, 1), ArchiveSheet.Cells(Archivelrow, 11)).Columns.AutoFit 'Autofit columns
Archivelrow = Archivelrow + 1 'Add one to lastrow
End If
Next i
SendKeys ("{ESC}")
End Sub
Те же строки, которые вы хотите скопировать, вы также хотите очистить данные ... и мы почти сделали код сверху. Вместо копирования мы заменим его и скажем: Range (xy) .ClearContents - Очистить содержимое ячейки для этого диапазона. Поскольку у вас есть формулы в столбце A, мы очищаем только ячейки от столбца B до столбца K
Таким образом, код будет:
Sub ClearContentMain()
'link this to recycling bin symbol
Dim i As Long
Dim MainClearlrow As Long
Dim Wkb As Workbook
Set Wkb = ThisWorkbook
Dim MainSheet As Worksheet
Set MainSheet = Wkb.Worksheets("MAIN")
Dim ArchiveSheet As Worksheet
Set ArchiveSheet = Wkb.Worksheets("ARCHIVE")
MainClearlrow = MainSheet.Cells(Rows.Count, 7).End(xlUp).Row 'take the last row by looking in column G
For i = 6 To MainClearlrow 'loop from row 6 to last row in column A and F
' Check if Column F = TOTAL, Check if Column A = DATE, Check if Column B has empty cells, Check Column A for last row that contain word TOTAL
If MainSheet.Cells(i, 6).Value = "TOTAL" Or MainSheet.Cells(i, 1).Value = "DATE" Or _
MainSheet.Cells(i, 2).Value = "" Or MainSheet.Cells(i, 1).Value Like "*TOTAL*" Then
'Do nothing
Else
MainSheet.Range(MainSheet.Cells(i, 2), MainSheet.Cells(i, 11)).ClearContents 'clear contents for only values that has values filled in Column A. except headers
End If
Next i
End Sub