Question

我正在尝试复制一系列行，其中所选行的行基于一个单元格中的值。我想对单元格中包含相同值的所有行执行此操作，然后转到下一个值附加到第一个列表的底部。

以下是我试图解释我希望实现的目标 - 希望上述内容有助于解释我的更多困境。我环顾四周但却找不到我想要的东西。我认为这很简单，可能就是。

我收到一个包含数千行数据和18列的数据转储。根据列P“合同”的值，我想将整行复制到新的单个工作表workingdata中。并非所有数据都会进入workingdata工作表。

合约编号为c1234，c1235，c2345等。

我实现的目标是复制和排序，因此复制合约编号为c1234的所有数据行，在workingdata中，然后直接在其下面复制合同为c1235的所有行，依此类推。

我以为我可以选择范围P：P并排序但无济于事。

Sheets("Data Dump").Select
Columns("P:P").Select
If Selection.Value = "C1234" Then
Selection.EntireRow.copy

我知道我应该发布我尝试过的内容，但这可能是可悲的，因为某些原因我似乎无法理解这一点。

这是我最近的努力 - 我知道有错误

Dim oWorksheet As Excel.Worksheet
Dim oRangeSource As Excel.Range
Dim oRangeDest As Excel.Range

Set oWorksheet = Worksheets("DataDump")
Set oRangeSource = oWorksheet.Range("p:p")
Set oRangeDest = Worksheets("workingdata")

If oRangeSource="CA0004000" Then Select.EntireRow

Selection.EntireRow.copy
Sheets("workingdata").Select.Paste
End If

最新的努力，但不排序数据或摆脱不必要的，我必须做一个手动过滤和排序哪种失败宏的对象

Sub copy()
'
' copy Macro
'
Dim rngContracts As Range:      Set rngContracts = Sheets("DataDump").Range("P:P")
Dim wsData As Worksheet

Dim wsFound As Boolean: wsFound = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    If ws.Name = "Working Data" Then
        Set wsData = ws
        wsFound = True
        Exit For
    End If
Next ws

If wsFound = False Then
    Application.CutCopyMode = False
    ActiveSheet.Range("A1").EntireRow.copy
    Set wsData = Sheets.Add(After:=Sheets(Sheets.Count))
    wsData.Name = "Working Data"
    wsData.Range("A1").EntireRow.PasteSpecial xlPasteAll, Transpose:=False
End If

Dim iCell As Range
For Each iCell In rngContracts
    If iCell.EntireRow.Hidden = False Then
        Application.CutCopyMode = False
        iCell.EntireRow.copy
        wsData.Range("P" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.PasteSpecial xlPasteAll, Transpose:=False
    End If
Next iCell

Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

最新的失败 - 复制我需要但不排序的数据：

Sub copytest()
'
' copytest Macro
'
Set MR = Sheets("data Dump").Range("P:P")

    For Each cell In MR

If cell.Value = "CA000154" Then
cell.EntireRow.copy
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial

    End If

If cell.Value = "CA000220" Then
cell.EntireRow.copy
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
    End If
If cell.Value = "CA000393" Then
cell.EntireRow.copy
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
    End If
If cell.Value = "CA000429" Then
cell.EntireRow.copy
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
    End If
Application.CutCopyMode = False

Next

End Sub

Answer 1

录制宏以设置数据过滤器仅选择一个过滤器。

然后，编辑代码并循环浏览每个过滤器，将可见范围复制到工作表上。这也必须对数据进行排序，因为过滤器已经过排序。

另外，请查看在Excel VBA帮助中创建有关使用它们进行排序的过滤器数组。

Excel 2007，根据1列中的值将行从一个工作表复制到另一个工作表

1 个答案: