Question

我有一个部分工作的VBA宏，它从一张'AverageEarnings'复制到两张之一（'SicknessRecordGraded'，'SicknessRecordUngraded'），条件是在第41列找到一个字符串（“GRADED”，“UNGRADED”）。
我希望宏将值B列，C（'AverageEarnings'）中的值从第3行复制到其他工作表上的A，B列。
目前它正在将第B，C，D列复制到第3行的另一张纸上的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列和B列中的数据。在此行中的C，您只需要将大小调整为1行2列：

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

更新了有关始终在第3行中粘贴的数据的评论。粘贴数据时，该行被标识为：

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

这从Cell C3开始，在当前区域内向上移动（就像按下END + UP一样），然后向下移动1行。这意味着如果您在C2中有一个标题行，然后是数据，则最终返回Cell C3以粘贴数据。假设你的桌子下面没有任何东西，我建议：

NextRow = Cells（1048576,3）.End（xlUp）.Row + 1

这从底部起作用，找到带数据的最后一行，然后取下面的单元格。您可能需要根据Excel版本中可用的行数调整Cells属性的行值（1048576）。

VBA宏 - 使用复制粘贴指定列。

1 个答案: