メインコンテンツへスキップ

Excelのセル値に基づいて行全体を別のシートに移動するにはどうすればよいですか？

セルの値に基づいて行全体を別のシートに移動するには、この記事が役立ちます。

VBAコードのセル値に基づいて、行全体を別のシートに移動します
Kutools for Excelを使用して、セル値に基づいて行全体を別のシートに移動します

VBAコードのセル値に基づいて、行全体を別のシートに移動します

以下のスクリーンショットに示すように、列Cに特定の単語「Done」が存在する場合は、行全体をSheet1からSheet2に移動する必要があります。次のVBAコードを試すことができます。

1。 押す 他の+ F11 キーを同時に開いて アプリケーション向け Microsoft Visual Basic 窓。

2. [Microsoft Visual Basic for Applications]ウィンドウで、[ インセット > モジュール。 次に、以下のVBAコードをコピーしてウィンドウに貼り付けます。

VBA code 1: Move entire row to another sheet based on cell value

Sub Cheezy()
'Updated by Kutools for Excel 2017/8/28
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Done" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Note：コードでは、 Sheet1 ワークシートには、移動する行が含まれています。 そして Sheet2 行を配置する宛先ワークシートです。 「「C：C」は特定の値を含む列であり、「クリックします」は、行を移動する特定の値です。 必要に応じて変更してください。

3。 プレス F5 キーを押してコードを実行すると、Sheet1の条件を満たす行がすぐにSheet2に移動します。

Note：上記のVBAコードは、指定されたワークシートに移動した後、元のデータから行を削除します。 行を削除するのではなく、セル値に基づいて行をコピーするだけの場合。 以下のVBAコード2を適用してください。

VBA code 2: Copy entire row to another sheet based on cell value

Sub MoveRowBasedOnCellValue()
'Updated by Extendoffice 2017/11/10
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Kutools for Excelを使用して、セル値に基づいて行全体を別のシートに移動します

VBAコードの初心者の場合。 ここで紹介します 特定のセルを選択 の有用性 Kutools for Excel。 このユーティリティを使用すると、ワークシート内の特定のセル値または異なるセル値に基づいてすべての行を簡単に選択し、必要に応じて選択した行をコピー先のワークシートにコピーできます。 次のようにしてください。

申請する前に Kutools for Excelについては 最初にダウンロードしてインストールします.

1.行を移動するセル値が含まれている列リストを選択し、をクリックします クツール > 選択 > 特定のセルを選択。 スクリーンショットを参照してください：

2.オープニングで 特定のセルを選択 ダイアログボックスで、 行全体 セクションに 選択タイプ セクション、選択 等しいです セクションに 特定のタイプ ドロップダウンリストで、テキストボックスにセルの値を入力し、[ OK

別の 特定のセルを選択 ダイアログボックスがポップアップして、選択した行の数が表示されます。その間、すべての行には、選択した列に指定した値が含まれています。 スクリーンショットを参照してください：

3。 プレス Ctrlキー + C キーを押して選択した行をコピーし、必要な宛先ワークシートに貼り付けます。

Note：XNUMXつの異なるセル値に基づいて行を別のワークシートに移動する場合。 たとえば、「完了」または「処理中」のセル値に基づいて行を移動すると、 Or の条件 特定のセルを選択 以下のスクリーンショットのようなダイアログボックス：

  このユーティリティの無料トライアル（30日）が必要な場合は、 クリックしてダウンロードしてください、次に、上記の手順に従って操作を適用します。

関連記事:

最高のオフィス生産性向上ツール

🤖 Kutools AI アシスタント: 以下に基づいてデータ分析に革命をもたらします。 インテリジェントな実行   |  コードを生成  |  カスタム数式の作成  |  データを分析してグラフを生成する  |  Kutools関数を呼び出す...
人気の機能: 重複を検索、強調表示、または識別する   |  空白行を削除する   |  データを失わずに列またはセルを結合する   |   数式なしのラウンド ...
スーパールックアップ: 複数の基準の VLookup  |   複数の値の VLookup  |   複数のシートにわたる VLookup   |   ファジールックアップ ....
詳細ドロップダウン リスト: ドロップダウンリストを素早く作成する   |  依存関係のドロップダウン リスト   |  複数選択のドロップダウンリスト ....
列マネージャー: 特定の数の列を追加する  |  列の移動  |  Toggle 非表示列の表示ステータス  |  範囲と列の比較 ...
注目の機能: グリッドフォーカス   |  デザインビュー   |   ビッグフォーミュラバー   |  ワークブックとシートマネージャー   |  リソースライブラリ (自動テキスト)   |  日付ピッカー   |  ワークシートを組み合わせる   |  セルの暗号化/復号化   |  リストごとにメールを送信する   |  スーパーフィルター   |   特殊フィルター (太字/斜体/取り消し線をフィルター...) ...
上位 15 のツールセット:  12 テキスト ツール (テキストを追加, 文字を削除する、...）   |   50+ チャート 種類 (ガントチャート、...）   |   40+ 実用的 式 (誕生日に基づいて年齢を計算する、...）   |   19 挿入 ツール (QRコードを挿入, パスから画像を挿入、...）   |   12 変換 ツール (数字から言葉へ, 通貨の換算、...）   |   7 マージ＆スプリット ツール (高度な結合行, 分割セル、...）   |   ... もっと

Kutools for Excel で Excel スキルを強化し、これまでにない効率を体験してください。 Kutools for Excelは、生産性を向上させ、時間を節約するための300以上の高度な機能を提供します。  最も必要な機能を入手するにはここをクリックしてください...

説明

Officeタブは、タブ付きのインターフェイスをOfficeにもたらし、作​​業をはるかに簡単にします

  • Word、Excel、PowerPointでタブ付きの編集と読み取りを有効にする、パブリッシャー、アクセス、Visioおよびプロジェクト。
  • 新しいウィンドウではなく、同じウィンドウの新しいタブで複数のドキュメントを開いて作成します。
  • 生産性を 50% 向上させ、毎日何百回もマウス クリックを減らすことができます!
Comments (306)
No ratings yet. Be the first to rate!
Pat
Pat
This comment was minimized by the moderator on the site
Hi,

I have a workbook with 9 sheets, the last 3 of which are irrelevant in terms of what I'm hoping to do. I keep all my data on Sheet1 (Sheet Name Withdrawn). I have used a code found here and modified it slightly to get closer to what I desire, but there are just a few features that I'm missing. Sheet1, Column B has a dropdown list. Lets call the dropdown choices "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Irrelevant1", "Irrelevant2", "Irrelevant3". On Sheet1, Column B, if "Sheet2" is chosen, I want that whole row to be copy and pasted into the first empty row on Sheet2. If "Sheet3" is chosen, I want the whole row to be copy and pasted to the first empty row in Sheet3. I want this same concept for choices "Sheet4", "Sheet5", and "Sheet6". I have accomplished all of this with the code I am using currently. I have also assigned a button to run this Macro.

Here's where I am coming up short from my ideal concept. I also want this to work so that when the choice in Sheet1, Column B is changed, it eliminates that row on the sheet that it was originally copy and pasted to. For instance, lets say I originally choose "Sheet2" from Column B in Sheet1, and therefore it copy and pastes this row to the first empty row in Sheet2. However, later I decide to change my choice in Sheet1, ColumnB for this row to "Sheet3". After hitting my button assigned to this Macro (Or better yet, if this process can somehow be automated), I want it to remove it from Sheet2 and now copy and paste it into Sheet 3, since that is what is chosen now in Sheet 1, Column B for that row. Also, if the choice in Sheet1, ColumnB is changed to "Irrelevant1", "Irrelevant2", or "Irrelevant3", I want it to remove it from all other sheets except Sheet1. Lastly, if a row is already copy and pasted to Sheet2, Sheet3, Sheet4, Sheet5, or Sheet6, I don't want it to be added again when the Macro is run again, which is what I have currenlty happening with my existing code.

Hope this isn't too hard to follow. I can share my workbook if it helps.
Reply
0
0
susanna
susanna
This comment was minimized by the moderator on the site
Thank you so much for this! It works very well, except like others who have commented -- I want the rows that move to be pasted in the first empty row. Is there a way to have it do that instead of going to the same row on the new sheet? Currently, if row 9 moves to a different sheet, it also fills row 9 on the new sheet. Thanks!

Code is:

Sub Done()
'Updated by Kutools for Excel 2017/8/28
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Big KS Comms List").UsedRange.Rows.Count
J = Worksheets("DONE").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("DONE").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Big KS Comms List").Range("D1:D" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "done" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("DONE").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "done" Then
K = K - 1
End If
J = J + 1
End If
Next
Reply
0
0
Ali J
Ali J
This comment was minimized by the moderator on the site
dear Crystal,

thank you very much for your help but I require your guidance once more 😅

I'm using your code as Module for my worksheet to move finished inquiries, as follow:

Sub Cheezy()
'Updated by Kutools for Excel 2017/8/28
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Master").UsedRange.Rows.Count
J = Worksheets("Delivered").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Delivered").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Master").Range("M1:M" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Delivered" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Delivered").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Delivered" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub


Also, to add date and time automatically, I'm using this code which doesn't seem to be working well with the Module:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range: Set M = Range("M:M")
Dim v As String
If Intersect(Target, M) Is Nothing Then Exit Sub

Application.EnableEvents = False
v = Target.Value
If v = "Agent Received" Then Target.Offset(0, 4) = Now()
If v = "Ready for Dispatch" Then Target.Offset(0, 2) = Now()
If v = "In Transit" Then Target.Offset(0, 3) = Now()
If v = "Delivered" Then Target.Offset(0, 5) = Now()
Application.EnableEvents = True
End Sub

by running the module, I end up with Error 13 type mismatch. Is there a way to fix this ?
Thank you.
Reply
0
0
Ali J
Ali J
This comment was minimized by the moderator on the site
Thank you very much for your help, all works fine.

for me it seems i have to Alt+F8 and run the module every time to get the rules working and rows moving.

is there a way to automate it ? thank you
Reply
0
0
crystal
crystal     Ali J
This comment was minimized by the moderator on the site
Hi,

In the worksheet that contains the rows you want to move based on cell values, right-click the Worksheet tab and click View Code from the context menu, then add the following VBA code to the Worksheet (Code) window.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Kutools for Excel 2023/11/17
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Done" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub
Reply
Report
0
0
Michelle Carbo
Michelle Carbo
This comment was minimized by the moderator on the site
I am using this code- it works OK BUT seems to be RANDOMLY placing the data on the Completed worksheet. I do not want it to overwrite any data- I would like it to ADD rows to a table or just to the spreadsheet.

Sub MoveRowsToComplete()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("To-Do List").UsedRange.Rows.Count
J = Worksheets("Completed").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Completed").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("To-Do List").Range("C1:C" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Complete" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Completed").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Done" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Reply
0
0
anthonykivy
anthonykivy
This comment was minimized by the moderator on the site
I am moving the row from a table in one sheet to a table in another sheet, the issue I am having the row being moved over to the first available row in the table. It always moves it to the end of the table or the row after the end of the table. Are you able to provide any insight?
Reply
Report
0
0
Elizabeth
Elizabeth
This comment was minimized by the moderator on the site
This has been the most helpful post! I have been trying to figure this out for a couple of weeks now and I can finally get my row to move. My question is. I have many tabs at the bottom and depending on the status in a specific column I would like them to go to that specific spreadsheet. I feel like I really configure it when I try to put more subs in.

Essentially, I have 8 tabs (worksheets) at the bottom and a drop down of statuses in column V of each of those tabs.
I would like to be able for the data to move and from worksheet to worksheet as needed based on the status.

I am only able to get this done for one (Form 1 to First Call)

Thank you for any help on being able to put multiple subs to get this accomplished.
Reply
0
0
Torben
Torben
This comment was minimized by the moderator on the site
Thanks for the superb code. I had to modify it a bit to make it work in connection with a project I had and found that it was less error prone in my version to have the for loop run in reverse and stepping back -1 which also eliminates the need for the K = K - 1 code line.
Reply
0
0
Deb
Deb
This comment was minimized by the moderator on the site
Wow! I love all the assistance you provide! Very cool!

Wondering if you may be able to help me...I have a workbook with two worksheets...One is for "Open Orders" and one is for "Closed Orders".

Currently, I have it set up so that there is a drop down list to determine if the work order is still open or in to be moved into closed status. When I choose "Closed" from the drop down list, I then hit Ctl/Shift/J and it moves it to the "Closed Orders" sheet adding it to the bottom row of the sheet. I then click on the "Closed Orders" sheet tab and use code to hit ctrl/shift/K to sort by the work order number.

Is there a way to automate everything so that when Idesignate the work order as "Closed" in the "Open Orders" sheet that it moves it to the "Closed Orders" sheet AND sorts by work order without having to do the ctrl/shift function in each sheet?

Thank you in advance for your assistance!!

Deb
Reply
0
0
crystal
crystal     Deb
This comment was minimized by the moderator on the site
Hi Deb,
I don't quite understand the "Sort" part you memtioned. Do you mind uploading your sample file here.
Reply
Report
0
0
TessL
TessL
This comment was minimized by the moderator on the site
Hello, I posted a comment a moment ago but realised I completely mucked it up, so let's try again!

I'm trying to use this code but need to make a few tweaks and can't figure out how.

The value I'm looking for is "Unplanned" and needs to be in column H, but from H3 down (exclude H1 and H2).
Instead of copying the entire row, I need to copy from A:D.
When pasting into the next sheet, I need it to start at A3.

Any help would be greatly appreciated!
Thanks 😊
Reply
Report
0
0
crystal
crystal     TessL
This comment was minimized by the moderator on the site
Ho Tess Laughlin,
The following code can help you solve the problem. Please give it a try. Thank you.
Sub Cheezy()
    'Updated by Kutools for Excel 20221128
    Dim xRg As Range
    Dim xStr As String
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 2
    End If
    Set xRg = Intersect(Range("H3:H1048576"), Worksheets("Sheet1").UsedRange)
    If xRg Is Nothing Then Exit Sub
    
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Unplanned" Then
            xStr = CStr(K + 2)
            Range("A" & xStr & ":D" & xStr).Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub
Reply
Report
0
0
TessL
TessL     crystal
This comment was minimized by the moderator on the site
This is great, thanks so much! :)
Reply
Report
0
0
There are no comments posted here yet
Load More
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations