Question

很抱歉最近的所有问题，但我对VB很新。在我的脚本中，当我在空白纸上运行它时，它运行得很完美。但是，当我尝试运行它来填充具有相同值的表时，它会在所有值之间放置大量空格。有什么我忘了把它放在脚本本身吗？

代码

For Each i In ddg

        Unit = "Unit #" & i

        LastRow = Sheets("Test").Range("A50000").End(xlUp).Row + 1

        Sheets(Unit).Range("A2:A100").Copy Destination:=Sheets("Test").Range("A" & LastRow)

        Sheets(Unit).Range("B2:B100").Copy Destination:=Sheets("Test").Range("D" & LastRow)

        Sheets(Unit).Range("C2:C100").Copy Destination:=Sheets("Test").Range("E" & LastRow)

        Sheets(Unit).Range("D2:D100").Copy Destination:=Sheets("Test").Range("F" & LastRow)

        Sheets(Unit).Range("E2:E100").Copy Destination:=Sheets("Test").Range("G" & LastRow)

        Sheets(Unit).Range("F2:F100").Copy Destination:=Sheets("Test").Range("L" & LastRow)


    Next i

Answer 1

您似乎正在尝试根据特定条件将值从一个工作表复制到另一个工作表。你的代码看起来很怪异。你知道你需要完全符合你的表格。试试吧。

Sub Copy_If_Criteria_Met()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("A1:A" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For Each xCell In xRg
        If CStr(xCell.Value) = "X" Then
            xCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            xCell.EntireRow.Delete
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Excel VB脚本填充表格

1 个答案: