保持非空行粘貼行完整性

Question

這是一個困難的Visual Basic問題，所以我不確定是否有人在此論壇將能夠提供幫助。但值得一試。

我在Visual Basic中編寫了一個程序，用作Excel中的宏。

在宏中，我正在將sheet1（FINAL）中的數據以及將值粘貼到sheet2（Data）中的&中。我在sheet1中的數據範圍有很多空白單元格，所以我想創建一個只粘貼具有值的行的程序（與只有空單元格的行相比）。

我的程序現在在粘貼到sheet2之前修改了表單1中的數據範圍，我不希望這...... ......我的格式化也因此而全部搞砸了。相反，我希望我的sheet1中的數據保持完全相同，在粘貼操作中要刪除的空行將進入sheet2。

我的工作表1中的數據從列AL開始並進入列CD。

保持行的完整性是非常重要的。我不希望空白單元格在粘貼過程中被刪除，而是要在粘貼過程中刪除範圍內的空白行。因此，如果在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 

截圖