Как да копирате само редове с данни от един работен лист в друг в различна работна книга?

Не разбирам точно какво се опитвате, но вярвам, че мога да ви дам някои полезни насоки.

Не обяснявам изразите, които използвам в кода по-долу. Потърсете ги в помощта на редактора на Visual Basic или опитайте да потърсите в мрежата за „Excel VBA xxxxx“. Върнете се с въпроси, ако е необходимо, но колкото повече можете да откриете за себе си, толкова по-бързо ще се развият уменията ви.

Първо трябва да намерите последния ред, съдържащ данни. Прегледът на всеки ред до AB30000 просто губи време. Макрос Demo1 по-долу демонстрира две техники. Има повече техники за намиране на последния ред, нито една от които не е подходяща във всяка ситуация. Потърсете в StackOverflow „[excel-vba] намери последния ред“. Има много уместни въпроси и отговори, въпреки че първата техника, която използвам, е най-популярната.

Общ съвет: Ако можете да разделите изискването си до поредица от единични проблеми (като „намерете последния ред“), ще намерите по-лесно да търсите отговор в StackOverflow.

Винаги включвайте Application.ScreenUpdating = False в началото на вашите макроси, ако възнамерявате да промените работен лист. Без този оператор всеки път, когато скриете ред, Excel прерисува екрана.

Създадох някои тестови данни, които се надявам да са представителни за вашите данни. Имам два работни листа Source и Dest. Source съдържа пълния набор от данни. Копирам избраните редове в Dest.

Използвах автоматичен филтър, който ще бъде много по-бърз от вашата техника, ако ще ви даде ефекта, който търсите. Играйте с Auto Filter от клавиатурата. Ако можете да получите ефекта, който търсите, включете записващото устройство за макроси, използвайте автоматичния филтър, за да получите селекцията, която търсите, и изключете записващото устройство за макроси. Коригирайте инструкциите на Macro Recorder, за да премахнете Selection и заменете съответните инструкции в Demo2.

Тайната на Demo2 е 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