保持非空行粘贴的行完整性

Question

这是一个很难的Visual Basic问题所以我不确定这个论坛中的任何人是否能提供帮助。但值得一试。

我在Visual Basic中编写了一个程序，用作Excel中的宏。

在宏中，我正在获取sheet1（FINAL）中的数据并复制＆amp;将值粘贴到sheet2（数据）。我在sheet1中的数据范围有很多空白单元格，所以我想创建一个只粘贴带有值的行的程序（与只有空单元格的行相对）。

我的程序现在修改了第1页中的数据范围，然后粘贴到sheet2中，我不希望这样......我的格式化也因此搞砸了。相反，我希望我的sheet1中的数据保持完全相同，并且粘贴操作中要删除的空行将进入sheet2。

我在sheet1中的数据从列AL开始，然后继续到列CD。

保持行的完整性非常重要。我不希望在粘贴期间擦除空白单元格，而是在粘贴期间擦除范围内的BLANK ROWS。因此，如果列AL和CD之间只有一行甚至只有一个数据点，则必须在粘贴中维护整个行。但是对于完全空白的AL和CD列之间的任何行，需要在进入sheet2的粘贴操作中删除它们。

我现有的计划如下。任何帮助将不胜感激。

Dim ws As Worksheet

Set ws1 = Worksheets("FINAL")
Set ws2 = Worksheets("Data")

With ws1.UsedRange
lastcolumn = .Cells(1, 1).Column + .Columns.Count - 1
lastrow = .Cells(1, 1).Row + .Rows.Count - 1
End With

ws1.Range(Cells(1, 38), Cells(lastrow, lastcolumn)).AutoFilter field:=1, Criteria1:="<>"
ws1.Range(Cells(1, 38), Cells(lastrow, lastcolumn)).Copy

ws2.Range("A1").PasteSpecial xlPasteValues

Application.CutCopyMode = False

Answer 1

  

这是一个很难的Visual Basic问题所以我不确定这个论坛中的任何人是否能提供帮助。但值得一试。

希望值得一试：P

这是你在尝试的吗？

Sub Sample()
    Dim wsInput As Worksheet, wsOutput As Worksheet
    Dim rng As Range, CellsTobeCopied As Range, aCell As Range

    '~~> Sheet which has range that you want to copy
    Set wsInput = ThisWorkbook.Sheets("Sheet1")

    '~~> Set range that you would like to copy
    Set rng = wsInput.Range("A1:E4")

    '~~> Output Sheet where you want to paste
    Set wsOutput = ThisWorkbook.Sheets("Sheet2")

    For Each aCell In rng.Rows
        '~~> Check if the entire row is blank
        If Application.WorksheetFunction.CountA(aCell) <> 0 Then
            '~~> Construct your range to be copied
            If CellsTobeCopied Is Nothing Then
                Set CellsTobeCopied = aCell
            Else
                Set CellsTobeCopied = Union(CellsTobeCopied, aCell)
            End If
        End If
    Next

    '~~> Copy final range
    If Not CellsTobeCopied Is Nothing Then
        CellsTobeCopied.Copy
        '~~> In case you want to preserve formats
        wsOutput.Range("A1").PasteSpecial xlPasteAll

        '~~> If you wan tto paste values then comment the above and use this
        ' CellsTobeCopied.Copy wsOutput.Range("A1")
    End If
End Sub

<强>截图