Question

我目前正在尝试开发一个脚本，该脚本从一个工作表移动到另一个工作表，并将数据从一个表复制到另一个表。我遇到的问题是源表没有填充数据的所有行，并且目标需要显示折叠的数据而没有空行。每次使用脚本时，源数据可以在100到1000行之间变化。

我尝试过多种解决方案，删除空白，删除重复项，但这些都无效。

这是我一直在使用的脚本。

Sub AS1055datacrunch()
    Sheets("Data Extract").Select
    Range("BI3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("AS 1055 Table").Select
    Range("C8").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True
    Call RemoveGaps
End Sub

Sub RemoveGaps()
    With Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        .value = .value
        .RemoveDuplicates Columns:=1, Header:=xlNo
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
        On Error GoTo 0
    End With
End Sub

我想知道有什么方法可以将数据复制到某种数组中然后粘贴在统一的数据表中。

Answer 1

这应该有用，它会删除空白行

Sub RemoveGaps()
    Dim ro As Integer, first As Integer, last As Integer
    first = Selection.Row
    last = first + Selection.Rows.Count - 1
    For ro = last To first Step -1
        ''checking for blank columns in column c to e
        If Application.WorksheetFunction.CountA(Range("C" & ro & ":" & "E" & ro)) = 0 Then
            Range(ro & ":" & ro).Rows.Delete Shift:=xlUp
        End If
    Next ro
End Sub

复制并粘贴数据数组以删除空白数据行

1 个答案: