Question

我正在尝试编写一个宏来将信息从一张纸复制并粘贴到另一张纸，具体取决于它是否在原始纸张上的第J列中标记为“即将进行/完成/进行中”（这称为“追踪器” “）。它的工作原理 - 但问题是它是从跟踪器表复制整行，我只想复制列A：K。理想情况下，它会将结果发布到Sheet1上的不同位置，具体取决于状态，但我可以随后提供另一个宏来执行此操作！我必须承认我正在孵化现有的宏，因为我在VBA上有点弱，所以这可能是问题的一部分。非常感谢你们。

Sub Copybasedonstatus()
'Niall McCracken 12/12/16

Dim lRow, cRow As Integer        
lRow = Sheets("Tracker").Range("A800").End(xlUp).Row

For j = lRow To 1 Step -1    
    If Sheets("Tracker").Range("J" & j) = "Upcoming" Then
        cRow = Sheets("Sheet1").Range("A800").End(xlUp).Row
        Sheets("Tracker").Rows(j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1)

    ElseIf Sheets("Tracker").Range("J" & j) = "Complete" Then
        cRow = Sheets("Sheet1").Range("A800").End(xlUp).Row
        Sheets("Tracker").Rows(j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1)

    ElseIf Sheets("Tracker").Range("J" & j) = "In Progress" Then
        cRow = Sheets("Sheet1").Range("A800").End(xlUp).Row
        Sheets("Tracker").Rows(j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1)

    End If
Next

End Sub

Answer 1

x一旦你决定要粘贴复制行的内容（或者在哪里）（A列：K列），请告诉我，我可以相应修改。

我使用With Sheets("Tracker")语句缩短代码（也有助于减少错误），同时我将If替换为Select Case .Range("J" & j).Value。

注意：如果不删除行或单元格，则无需向后循环。如果您愿意，可以使用常规For j = 1 To lRow。

<强>代码

Option Explicit

Sub Copybasedonstatus()

'Niall McCracken 12/12/16

Dim lRow As Long, cRow As Long, j As Long

With Sheets("Tracker")
    lRow = .Range("A800").End(xlUp).Row

    ' another method of finding last row in Column A (skipping blank cells in the middle)
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    For j = lRow To 1 Step -1
        cRow = Sheets("Sheet1").Range("A800").End(xlUp).Row

        Select Case .Range("J" & j).Value
            Case "Upcoming"
                .Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1)

            Case "Complete"
                .Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1)

            Case "In Progress"
                .Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1)

        End Select
    Next
End With

End Sub

VBA宏复制和粘贴，粘贴到离散位置

1 个答案: