[英]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.