VBA宏-使用復制粘貼指定列。

Question

我有一個部分工作的VBA宏，它在第41列（“ GRADED”和“ UNGRADED”）中找到字符串的情況下，將其從一張工作表“ AverageEarnings”復制到兩張工作表（“ SicknessRecordGraded”，“ SicknessRecordUngraded”）中。
我希望宏從第3行將值從B，C列（“ AverageEarnings”）復制到其他工作表的A，B列。
目前，它正在將B，C，D列復制到第三行另一張紙上的A，B，C列。
此外，我從初始工作表中接收到太多值，其中有4957個。這是我的宏。

Public Sub CopyRowsSickness()

' This macro will copy rows in AverageEarnings spreadsheet, to Sheet1 if Ungraded (Column AO) or to Sheet2 if Graded.

    ' Insert message box to warn user.
    If MsgBox("This could take some time. (5 - 10 mins). Proceed?", vbYesNo) = vbNo Then Exit Sub

    ' Select initial sheet to copy from
    Sheets("AverageEarnings").Select
    ' Find the last row of data - xlUp will check from the bottom of the spreadsheet up.
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    ' For loop through each row
    For x = 1 To FinalRow

        ThisValue = Cells(x, 41).Value    ' The value to check is located in Column AO or 41.

        If ThisValue = "UNGRADED" Then    ' If the value is Ungraded
            Cells(x, 2).Resize(5000, 3).Copy ' Resize from intial range.
            Sheets("SicknessRecordUngraded").Select    ' Specify first sheet to copy to.
             NextRow = Cells(3, 3).End(xlUp).Row + 1    '   <-- This line instead of next if you dont want paste over top.
            'NextRow = Cells.Row + 1
            ' Rows.Count, 1
            Cells(NextRow, 1).Select ' Find the next row.
            ActiveSheet.Paste ' Paste information.
            Sheets("AverageEarnings").Select 'Reselect sheet to copy from.

        ElseIf ThisValue = "GRADED" Then
            Cells(x, 2).Resize(5000, 3).Copy
            Sheets("SicknessRecordGraded").Select
            NextRow = Cells(3, 3).End(xlUp).Row + 1
            'NextRow = Cells.Row + 1 ' Increment row.
            ' Rows.Count, 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("AverageEarnings").Select

        End If
    Next x
End Sub

我知道問題出在這兩行的值之內。 我已將它們修改為各種不同的值，但尚未解決。 與“ AverageEarnings”中的值相比，它似乎粘貼了更多的值。

Cells(x, 2).Resize(5000, 3).Copy

NextRow = Cells(3, 3).End(xlUp).Row + 1

Answer 1

在復制之前，您正在將要復制的范圍調整為5000行乘3列：

Cells(x, 2).Resize(5000, 3).Copy

如果只想從該行的B和C列復制數據，則只需將大小調整為1行乘2列：

Cells(x, 2).Resize(1, 2).Copy

已更新，以獲取有關始終將數據粘貼到行3中的注釋。粘貼數據時，該行被標識為：

NextRow = Cells(3, 3).End(xlUp).Row + 1

它從單元格C3開始，在當前區域內向上移動（就像按END + UP），然后向下移動1行。 這意味着，如果您在C2中有一個標題行，然后是數據，則最終返回到單元格C3以粘貼數據。 假設您的桌子下面沒有東西，我建議：

NextRow =單元格（1048576，3）.End（xlUp）.Row + 1

這將從底部開始，以查找包含數據的最后一行，然后采用該行下方的單元格。 您可能需要根據Excel版本中可用的行數來調整“單元格”屬性的行值（1048576）。