Excelに関する質問です。特定のキーワードを含む行全てを1つずつ、別シートに移動させるマクロはないでしょうか。

Question

moon-fondu

236

235もっと見る

360pt

コンピュータ学習・教育

Excelに関する質問です。特定のキーワードを含む行全てを1つずつ、別シートに移動させるマクロはないでしょうか。

Sheet1のF列に、ずらりとデータが10000行近く並んでおります。
この中から、「りんご」という文字列を含む（前文一致・後文一致・部分一致）セルがあった場合、そのセルのある“行”を全て“切り取り”し、Sheet2のシートに移すことは出来ないでしょうか。

“切り取り”ではなく“コピー”でも問題ないのですが、Sheet1からは「りんご」文字列を含むデータを後に削除したいです。

よろしくお願い致します。

回答の条件

1人5回まで

登録：2015/06/13 20:17:42
終了：2015/06/18 00:39:16

※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

No.1

やじるし402015/06/14 00:27:34

10pt

https://www.youtube.com/watch?v=OSORil3rF9M
http://superdbtool.com/blog/wp/wp-content/uploads/2015/06/1434194262.PNG

ありがとうございます。動画を拝見しました。表作ったり、少し大変そうですね。。。

2015/06/18 00:36:58

No.2

Mook13143932015/06/14 01:44:40

50pt

1行目はタイトル行の前提です。

Sub MoveData()
    Const KeyWord = "りんご"
    
    Dim srcWS As Worksheet
    Set srcWS = Worksheets("Sheet1")
    
    Dim dstWS As Worksheet
    Set dstWS = Worksheets("Sheet2")
    dstWS.Cells.Clear
    
    If srcWS.AutoFilterMode Then srcWS.AutoFilterMode = False
    srcWS.UsedRange.AutoFilter Field:=6, Criteria1:="=*" & KeyWord & "*"
    srcWS.Range("A1").CurrentRegion.EntireRow.Copy dstWS.Range("A1")
    
    srcWS.Range("A1").CurrentRegion.EntireRow.Delete
    
    srcWS.AutoFilterMode = False
    srcWS.Rows(1).Insert
    dstWS.Rows(1).Copy srcWS.Rows(1)
End Sub

ありがとうございます！マクロは実行できたのですが…なぜかデータを移動させたり、うまくいきませんでした。タイトル行の後に空白の行とかいろいろあったからでしょうか・・・。

2015/06/18 00:37:52

コメントはまだありません

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

リクエスト送信済

回答リクエストを送信したユーザーはいません

きゃづみぃ · Accepted Answer · 2015-06-14T09:40:37+09:00

Sub main()
Dim a As Long
Dim b As Long
Dim c As Long

移動元シート = "Sheet1"
移動先シート = "Sheet2"

b = Worksheets(移動元シート).Cells(Rows().Count, "F").End(xlUp).Row
c = Worksheets(移動先シート).Cells(Rows().Count, "F").End(xlUp).Row
If c = 1 And Worksheets(移動先シート).Cells(1, "F") = "" Then
Else
    c = c + 1
End If
    

For a = b To 1 Step -1
    If InStr(Worksheets(移動元シート).Cells(a, "F"), "りんご") > 0 Then
        
        Worksheets(移動元シート).Rows(a).Cut
        Worksheets(移動先シート).Rows(c).Insert Shift:=xlDown
        Worksheets(移動元シート).Rows(a).Delete Shift:=xlUp
        c = c + 1
    End If
Next a

End Sub

きゃづみぃ · Accepted Answer · 2015-06-14T09:40:37+09:00

Sub main()
Dim a As Long
Dim b As Long
Dim c As Long

移動元シート = "Sheet1"
移動先シート = "Sheet2"

b = Worksheets(移動元シート).Cells(Rows().Count, "F").End(xlUp).Row
c = Worksheets(移動先シート).Cells(Rows().Count, "F").End(xlUp).Row
If c = 1 And Worksheets(移動先シート).Cells(1, "F") = "" Then
Else
    c = c + 1
End If
    

For a = b To 1 Step -1
    If InStr(Worksheets(移動元シート).Cells(a, "F"), "りんご") > 0 Then
        
        Worksheets(移動元シート).Rows(a).Cut
        Worksheets(移動先シート).Rows(c).Insert Shift:=xlDown
        Worksheets(移動元シート).Rows(a).Delete Shift:=xlUp
        c = c + 1
    End If
Next a

End Sub

Excelに関する質問です。特定のキーワードを含む行全てを1つずつ、別シートに移動させるマクロはないでしょうか。

ベストアンサー

きゃづみぃ1353911982015/06/14 09:40:37

その他の回答（2件）

やじるし402015/06/14 00:27:34

Mook13143932015/06/14 01:44:40

きゃづみぃ1353911982015/06/14 09:40:37ここでベストアンサー

コメント（0件)

この質問への反応（ブックマークコメント）