【问题标题】:Excel VBA to Copy Multiple Ranges and paste to another sheet, no empty rowsExcel VBA复制多个范围并粘贴到另一个工作表,没有空行
【发布时间】:2018-11-04 14:29:16
【问题描述】:

在研究和测试之后,简单地将 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

【问题讨论】:

  • 您的 SkipBlanks 将不起作用,因为您有 =False

标签: excel vba


【解决方案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,其中 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 列中,我们不想复制带有“日期”、“星期一”等标题的单元格。

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

【讨论】:

  • 非常感谢详细的回答。感谢您抽出宝贵时间。我将不得不研究一段时间以了解语法。 :) 我在 Google 应用程序脚本中做了同样的事情,它看起来更加直接和简单。我试图在 VBA 中做同样的事情。我会试一试。再次感谢。
  • 不! :)。这样做,希望它有点清楚;),如果有任何问题,请随时询问:)。不会让我感到惊讶。 VBA 的某些部分我不认为这是合乎逻辑的......:P
  • 好的,我有时间深入研究它并围绕它进行思考。我只需要帮助理解与行相关的数字。例如“For i = 6”和“(rows.count, 7)”。我正在努力真正理解,这样我才能继续变得更好。再次感谢您的时间!非常感谢您的帮助。
  • 所以要找到最后一行,我们使用rows.count。我们不想循环更多我们真正需要的行(这需要时间)。我们使用第 7 列(G 列)来计算行数。 // 所以当我们知道最后一行(循环的终点)时,我们还需要为我们的循环设置一个起点。 For i = 6,将是我们从第 6 行开始,因为您可能要复制的第一个值存在于第 6 行及以下。因此,我们完整的For i 循环将是:For i = 6 to "last row"
  • 好的,有道理。再次感谢!
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2019-02-06
  • 2020-04-09
  • 1970-01-01
  • 1970-01-01
  • 2015-10-03
相关资源
最近更新 更多