excel - 如何仅将包含数据的行从一个工作表复制到另一个工作簿中的另一个？

Question

我可以组合一个体面的宏来满足我的需要，但我忘记了范围每天都会改变。
具体来说，行数会更高。
现在我的宏通过并隐藏任何没有今天日期的行，然后将一组范围复制到不同工作簿中的工作表中。
我唯一的问题是范围每天都会改变，所以我想我需要一种方法来只复制其中包含数据的行，一旦其余的被隐藏，然后将它们粘贴到另一个工作簿。

Sub automate()
Dim cell As Range
For Each cell In Range("AB2:AB30000")
If cell.Value < Date And cell.Value <> Empty Then cell.EntireRow.Hidden = True
Next
   Range("K28336:K28388,O28336:O28388,P28336:P28388,Q28336:Q28388,R28336:R28388,S28336:S28388,T28336:T28388,U28336:U28388,V28336:V28388,Y28336:Y28388,AA28336:AA28388,AB28336:AB28388").Select
Selection.Copy
Workbooks.Open ("\\gvwac09\Public\Parts\Test\2014 IPU.xlsx")
Sheets("Historical Data").Activate
ActiveSheet.Range("c1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteFormats
ActiveSheet.Paste

到目前为止，这是我的宏。如果我没有正确格式化这篇文章，我很抱歉，这是新手。

Answer 1

我不明白你在尝试什么，但我相信我可以给你一些有用的指示。

我不解释我在下面的代码中使用的语句。在 Visual Basic 编辑器的帮助中查找它们或尝试在 Web 上搜索“Excel VBA xxxxx”。如有必要，请提出问题，但您自己发现的越多，您的技能发展就越快。

首先，您需要找到包含数据的最后一行。检查每一行直到 AB30000 只是浪费时间。宏 Demo1下面演示了两种技术。找到最后一行的技术还有很多，但没有一种技术适用于所有情况。在 StackOverflow 中搜索“[excel-vba] 查找最后一行”。尽管我使用的第一种技术是最受欢迎的，但有很多相关的问题和答案。

一般建议:如果您可以将您的需求分解为一系列单个问题(例如“查找最后一行”)，您会发现在 StackOverflow 中搜索答案会更容易。

始终包括 Application.ScreenUpdating = False如果要修改工作表，请在宏的开头。如果没有此语句，每次隐藏一行时，Excel 都会重新绘制屏幕。

我创建了一些测试数据，希望它们能代表您的数据。我有两个工作表 Source和 Dest . Source包含完整的数据集。我将选定的行复制到 Dest .

我使用了自动过滤器，如果它能给你想要的效果，它会比你的技术快得多。从键盘玩自动过滤器。如果你能得到你想要的效果，打开宏记录器，使用自动过滤器来获得你想要的选择，然后关闭宏记录器。调整宏记录器的语句以删除 Selection并替换Demo2中的相应语句.
Demo2的 secret 是 Set Rng = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)设置Rng到可见行。如果您无法让自动过滤器按您的意愿工作，并且您决定使用当前技术将不感兴趣的行设置为不可见，请保留此语句以获取剩余的行。但是，我认为宏Demo3使用更好的技术。

Option Explicit
Sub demo1()

  Dim ColLast As Long
  Dim Rng As Range
  Dim RowLast As Long

  Application.ScreenUpdating = False

  With Worksheets("Source")

    ' This searches up from the bottom of column AB for a cell with a value.
    ' It is the VBA equivalent of placing the cursor at the bottom of column AB
    ' and clicking Ctrl+Up.
    RowLast = .Cells(Rows.Count, "AB").End(xlUp).Row
    Debug.Print "Last row with value in column AB: " & RowLast

    ' This searches for the last cell with a value.
    Set Rng = .Cells.Find(What:="*", After:=.Range("A1"), SearchDirection:=xlPrevious)

    If Rng Is Nothing Then
      ' Worksheet is empty
    Else
      RowLast = Rng.Row
      ColLast = Rng.Column
      Debug.Print "Last cell with value is: (" & RowLast & ", " & ColLast & _
                  ") = " & Replace(Rng.Address, "$", "")
    End If

  End With

End Sub
Sub Demo2()

  Dim Rng As Range
  Dim SearchDate As String

  SearchDate = "14-May-14"

  Application.ScreenUpdating = False

  With Sheets("Source")
    .Cells.AutoFilter
    .Cells.AutoFilter Field:=28, Criteria1:=SearchDate
    Set Rng = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
  End With

  ' Rng.Address has a maximum length of a little under 256 characters.
  ' Rng holds the addresses of all the visible rows but you cannot display
  ' all those addresses in an easy manner.  However, this is only to give
  ' you an idea of what is in Rng; the Copy statement below uses the full
  ' set of addresses.
  Debug.Print "Visible rows: " & Rng.Address

  Rng.Copy Worksheets("Dest").Range("A1")

End Sub
Sub Demo3()

  Dim RngToBeCopied As Range
  Dim RowCrnt As Long
  Dim RowLast As Long
  Dim SearchDate As Long

  ' Excel holds dates as integers and times as fractions.
  SearchDate = CLng(DateValue("20 May 2014"))

  With Worksheets("Source")

    RowLast = .Cells(Rows.Count, "AB").End(xlUp).Row

    ' Include header row in range to be copied
    Set RngToBeCopied = .Rows(1)

    For RowCrnt = 2 To RowLast
      If .Cells(RowCrnt, "AB").Value = SearchDate Then
        Set RngToBeCopied = Union(RngToBeCopied, .Rows(RowCrnt))
      End If
    Next

  End With

  Debug.Print RngToBeCopied.Address
  RngToBeCopied.Copy Worksheets("Dest").Range("A1")

End Sub