[英]Excel 2007, Copying rows from one sheet to another based on a value in 1 column
我正在尝试复制一系列行,其中选择的行基于一个单元格中的值。我想对一个单元格中包含相同值的所有行执行此操作,然后移至下一个值并追加到第一个列表的底部。
以下是我尝试解释我希望达到的目标的尝试-希望以上内容可以帮助解释我的更多难题。 我已经四处寻找,但还没有找到我想要的。 我认为这很简单,也许是。
我收到包含数千行数据和18列的数据转储。 基于列P“ Contract”的值,我想将整个行复制到新的单个工作表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
最新的attaempt-复制我需要但未排序的数据:
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
记录宏以在数据上设置过滤器,仅选择一个过滤器。
然后,编辑代码并遍历每个过滤器,将可见范围复制到工作表上。 这也必须对数据进行排序,因为过滤器已经排序。
另外,请看一下如何在Excel VBA帮助中创建过滤器数组以使用它们进行排序。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.