Question

经过研究和测试，将Excel中的一系列数据简单地复制到一张纸上，仅保留值并将它们粘贴到另一张纸上，这似乎是相当基本的。我想要达到的目的是要有一个每周使用的时间卡模板。填写完一周的信息后，我单击软盘符号，将所有数据复制并粘贴到下一个可用行之后的ARCHIVE表中。然后将另一个脚本附加到回收站符号上，清除条目，以便在下周准备好。哦，“复印机”符号也只是创建了一个副本，可以将其归档或发送给工资单。但是，我遇到了一个问题，因为我正在复制多个范围，并且它们在每个范围的每一行中都不会始终具有值。（有些日子我只从事一项工作，有些日子所有行可能都有值）似乎结果也显示空白行。我想要所有数据的干净整洁的连续存档，而不必删除空白行。我认为代码的“ SkipBlanks”部分将消除这种情况，但事实并非如此。

是否可以更改VBA以消除空白？

Sub SaveToArchive()

response = MsgBox("Are You Sure?", vbYesNo)

If response = vbNo Then
MsgBox ("Goodbye!")
Exit Sub

End If

Sheets("MAIN").Range("A6:K11,A14:K19,A22:K27,A30:K35,A38:K43,A46:K50").Copy

Sheets("ARCHIVE").Select
Range("A65536").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("A1").Select

Sheets("MAIN").Select
Range("B3").Select

SendKeys ("{ESC}")



End Sub

Answer 1

“ SkipBlanks”用于要复制的范围，并且粘贴到新位置时不希望使用空白/空数据获取先前的values overwritten 。但是，它不会排除您范围内的任何单元格。因此，您仍然会得到“空”行。

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")

如果将这两个1A和2A结合使用，我们可以在同一工作簿中引用不同的工作表。

MainSheet.Range(MainSheet.Cells(73, 19), MainSheet.Cells(128, 19))->是工作表“ Main”的范围“ 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，其中row是我们可以用来引用最后一行的变量。

3A-我们可以遍历列中的每个单元格，并仅使用“ FOR循环”来选择我们感兴趣的单元格。这将使您的范围充满活力。如果添加或删除行，我们只会遍历更多或更少的行。

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列中，我们不想复制带有标题的单元格，例如：“日期”，“星期一”等。

4A-如果声明可以帮助我们。我们可以设置条件（一个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

这将使您的完整代码成为（更新）：

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

Excel VBA复制多个范围并粘贴到另一个工作表，没有空行

1 个答案: