跳到主要內容

如何根據條件將多個工作表中的行複製到新工作表中?

假設您有一個包含三個工作表的工作簿,這些工作表的格式與下面的屏幕快照相同。 現在,您想要將這些工作表中的C列包含“已完成”文本的所有行複製到新工作表中。 您如何快速,輕鬆地解決此問題,而又不手動一一複制和粘貼它們?

根據條件將多個工作表中的行複製到具有VBA代碼的新工作表中


根據條件將多個工作表中的行複製到具有VBA代碼的新工作表中

下面的VBA代碼可以幫助您根據特定條件將工作簿中所有工作表中的特定行複製到新工作表中。 請這樣做:

1。 按住 ALT + F11 鍵打開 Microsoft Visual Basic for Applications 窗口。

2。 點擊 插入 > 模塊,然後將以下代碼粘貼到“模塊窗口”中。

VBA代碼:根據條件將多個工作表中的行複製到新工作表中

Public Sub CopyRows_ValuesAndNumberFormats()
Dim xWs As Worksheet
Dim xCWs As Worksheet
Dim xRg As Range
Dim xStrName As String
Dim xRStr As String
Dim xRRg As Range
Dim xC As Integer
On Error Resume Next
Application.DisplayAlerts = False
xStr = "Kutools for Excel"
xRStr = "Completed"
Set xCWs = ActiveWorkbook.Worksheets.Item(xStr)
If Not xCWs Is Nothing Then
    xCWs.Delete
End If
Set xCWs = ActiveWorkbook.Worksheets.Add
xCWs.Name = xStr
xC = 1
For Each xWs In ActiveWorkbook.Worksheets
    If xWs.Name <> xStr Then
        Set xRg = xWs.Range("C:C")
        Set xRg = Intersect(xRg, xWs.UsedRange)
        For Each xRRg In xRg
            If xRRg.Value = xRStr Then
               xRRg.EntireRow.Copy
               xCWs.Cells(xC, 1).PasteSpecial xlPasteValuesAndNumberFormats
               xC = xC + 1
            End If
        Next xRRg
    End If
Next xWs
Application.DisplayAlerts = True
End Sub

備註:在上面的代碼中:

  • 文本 ”完成”在此 xRStr =“已完成” 腳本指示您要基於其複制行的特定條件;
  • C:C 參看 設置xRg = xWs.Range(“ C:C”) 腳本指示條件所在的特定列。

3。 然後按 F5 鍵以運行此代碼,並且所有具有特定條件的行均已復制並粘貼到當前工作簿中名為Kutools for Excel的新工作表中。 看截圖:


更多相關的拉取或複制數據文章:

  • 使用Excel中的高級篩選器將數據複製到另一個工作表
  • 通常,我們可以快速應用“高級篩選器”功能從同一工作表中的原始數據中提取數據。 但是,有時,當您嘗試將篩選的結果復製到另一個工作表時,會收到以下警告消息。 在這種情況下,您如何在Excel中處理此任務?
  • 根據Excel中的列條件將行複製到新表
  • 例如,有一個水果購買表,現在您需要根據指定的水果將記錄複製到新表中,如何在Excel中輕鬆完成它? 在這裡,我將介紹幾種基於Excel中的列條件將行複製到新工作表的方法。
  • 如果列在Excel中包含特定的文本/值,則復制行
  • 假設您要找出一列中包含特定文本或值的單元格,然後復制找到的單元格所在的整行,您該如何處理? 在這裡,我將介紹幾種方法來查找列是否包含特定的文本或值,然後在Excel中復制整個行。

  • 超級公式欄 (輕鬆編輯多行文本和公式); 閱讀版式 (輕鬆讀取和編輯大量單元格); 粘貼到過濾範圍...
  • 合併單元格/行/列 和保存數據; 拆分單元格內容; 合併重複的行和總和/平均值...防止細胞重複; 比較範圍...
  • 選擇重複或唯一 行; 選擇空白行 (所有單元格都是空的); 超級查找和模糊查找 在許多工作簿中; 隨機選擇...
  • 確切的副本 多個單元格,無需更改公式參考; 自動創建參考 到多張紙; 插入項目符號,複選框等...
  • 收藏并快速插入公式,範圍,圖表和圖片; 加密單元 帶密碼 創建郵件列表 並發送電子郵件...
  • 提取文字,添加文本,按位置刪除, 刪除空間; 創建和打印分頁小計; 在單元格內容和註釋之間轉換...
  • 超級濾鏡 (將過濾方案保存並應用於其他工作表); 高級排序 按月/週/日,頻率及更多; 特殊過濾器 用粗體,斜體...
  • 結合工作簿和工作表; 根據關鍵列合併表; 將數據分割成多個工作表; 批量轉換xls,xlsx和PDF...
  • 數據透視表分組依據 週號,週幾等 顯示未鎖定的單元格 用不同的顏色 突出顯示具有公式/名稱的單元格...
kte選項卡201905
  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,發布者,Access,Visio和Project。
  • 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
  • 將您的工作效率提高 50%,每天為您減少數百次鼠標點擊!
officetab底部
Comments (2)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hi,

thank you very much for the code. I have a question: the code runs smoothly on some of my sheets, but looks like enters an infinite loop in some other ones which makes excel crash. What could the reason be?
This comment was minimized by the moderator on the site
Hello there, thank you so much for the code above, it solved me a problem with a complex file; a solution I have been looking for a while now. Thank you..I have one question. How do I change the code so that it copies the rows but only from colum A to colum Q, so not Entire.Row?Thank you in advance and great work!
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations