• 締切済み

エクセル VBA 特定文字がある行を別シートに移動

ソフト　excel2003 o列に文字列が入力された表があります。 マクロ実行時下記のようにするには、VBAのコードをどのように記入すればよろしいでしょうか？ 赤枠で囲んだボタンをクリックすると シート１のO列に　中　が入力されている行を切り取りし中シートに貼り付け （下の行は上方向にシフト） ※　シート１の内容は日毎に更新されますので、更新後、赤枠で囲んだボタンをクリックするとその時点で　中　が入力されているものは中シートのリストへ追加されるようにしたいのです。 以前ここで教えていただいたものを参考に作成してみたの（以下に記載）ですがうまくいきません。 お助けいただけないでしょうか。 宜しくお願い致します。 Sub ボタン中シート_Click() 'Sheet2の挿入位置(C列は結合セルではなく、必ず何か入っている事） nMax2 = Sheets("中シート").Cells(Rows.Count, 3).End(xlUp).Row + 1 With Sheets("sheet1") nMax1 = .Cells(Rows.Count, 9).End(xlUp).Row For i = nMax1 To 2 Step -2 If .Cells(o, 15) = "中" Then .Range(.Cells(o, 1), .Cells(o + 1, 10)).Copy Sheets("中シート").Cells(nMax2, 1).Insert Shift:=xlDown .Range(.Cells(o, 1), .Cells(o + 1, 10)).Delete Shift:=xlUp End If Next i End With End Sub

画像を拡大する

みんなの回答

  • pa_cotta
  • ベストアンサー率43% (25/58)
回答No.1

※直接の回答ではないです。今手元にExcelがないため… Excelの機能で、「マクロの記録」というのがあります。これは記録開始から終了までの操作をマクロに落とし込む機能ですが、この機能を使って自分がマクロでやりたいことを操作として行うと、その内容がマクロに記述されていきます。 余計なもの(セルの移動とか、過剰なオブクジェクト指定とか)も入ってしまいますが、これを参考に余計な部分を削ったり、不足しているところを追加していくといいかと思います。

asamiya
質問者

補足

早々の回答ありがとうございます。 資料作成の締め切りが週明けで、緊急でＶＢＡのコードを知りたいのでご教授頂けないでしょうか。 お手数ですが宜しくお願い致します。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • エクセルで入力シートから別シートに転記・蓄積について

    エクセルＶＢＡで入力シートのA1:D5（５行）の範囲を別シート（DBシート）の転記・蓄積させる方法を教えてください。また、入力データがA1:A5（１行）のときもあれば、A1:D5（５行）の場合ですが・・・ Sub test01() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Long, y As Long Set ws1 = Sheets("入力") Set ws2 = Sheets("DB") x = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1 y = ws1.Cells(Rows.Count, "A").End(xlUp).Row ws1.Cells(1, "A").Resize(y, 4).Copy ws2.Cells(x, "A") End Sub の場合、数式等、入力値すべてが転記となってしまいます。 値だけ転記する方法はありませんか？ 宜しくお願いいたします。

  • 特定の文字を含むシートを選択するには

    いつもお世話になっております。 特定の文字を含むシートのデータをコピーするにはどのようにしたらよろしいでしょうか。 具体的には (1)シート名の末尾に"D"を含むシートを選択 (2)選択したシートのデータをコピー (3)コピーしたデータを順次"Sheet1"に貼付 というマクロを組みたいのですが、(1)のところがうまくいきません。 以下のように作成してみました。 Dim sh As Worksheet Dim lr As Long, tlr As Long For Each sh In Worksheets If sh.Name = "*D" Then lr = sh.Cells(ActiveSheet.Rows.Count, 3).End(xlUp).Row sh.Rows("3:" & lr).Copy tlr = Sheets("Sheet1").Cells(ActiveSheet.Rows.Count, 3).End(xlUp).Row Sheets("Sheet1").Range("A" & tlr + 1).PasteSpecial End If Next 4行目の sh.Name = "*D" のところがうまくないようです。 よろしくお願いします。

  • エクセル2003　別シートの項目を集計したいVBA

    仕事でエクセル2003を使っています。 超初心者なので、うまく説明ができませんがお許しください。 Sheet1に、印刷シートとして「名前」「フリガナ」「住所」「電話番号」「性別」などのデータを入力しています。 これを1回ずつデータを入力して印刷をしています。 印刷をするときに、入力したデータをリストにするためにSheet2へコピーするというマクロを作りました。 ↓こんな風に作ってみました。 Sub 正方形長方形2_Click() Call macro01 Call macro02 End Sub Sub macro01() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Long, y As Long Set ws1 = Sheets("Sheet1") Set ws2 = Sheets("Sheet3") x = ws2.Cells(Rows.Count, "b").End(xlUp).Row + 1 y = ws1.Cells(Rows.Count, "b").End(xlUp).Row ws1.Cells(21, "ｇ").Resize(y, 9).Copy ws2.Cells(x, "b").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End Sub Sub macro02() Worksheets("Sheet1").PrintOut End Sub ここから本題なのですが… ふと、リストの件数をSheet1に出せないものか？と思ったのです。 マクロを実行することで、Sheet2にデータが増えてその増えたデータの項目の合計件数をSheet1に反映させて印刷する。 「別シートの項目を集計する」で検索してみたのですが、私には難しすぎて理解できずいろんな方の回答をもアレンジできません。 なにとぞ、ご教授いただきますようお願いします。

  • 再質問　EXCEL　データをコピーして別シートの最初の空白行に貼り付け

    再質問　EXCEL　データをコピーして別シートの最初の空白行に貼り付けたい QNo.6023986でEXCEL　データをコピーして別シートの最初の空白行に貼り付けたいと書き込んだものです。 質問内容は以下の通りです。 Sheet１はA列からR列までを使ったシートで、1行目は各項目があり、2行目からは当月のデータが入力されています。 Sheet２はSheet１の1行目と同じようにA列からR列までが項目になっていて、期中のデータを付け足していきたいと思っています。 マクロの記録でやってみたのですが、前月の最後の行（貼り付ける最初の空白行)の認識の仕方が分からず、Sheet２への貼付がうまくいきません。 どのような方法でやったらいいのか教えて下さい。 ----------------------------------------------------------------------------------- 回答で以下のマクロを教えていただき、テストではうまくいったのですが、 ひとつのブック内でsheet１をsheet2に、sheet3をsheet4に、sheet5をsheet6にと行いたいので、 以下のコードのシート名をそれぞれ書き換えてやってみました。 ところが、１を２にはできたのですが、３を４でやってみたところ、 なんどやっても『400』というエラーが出てしまいます。 シート名の他にも書き換えが必要なのか教えてください。 よろしくお願いします。 Sub Macro1() GYOU1 = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row GYOU2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets("Sheet1").Select Range(Cells(2, 1), Cells(GYOU1, 18)).Copy Sheets("Sheet2").Select Range("A" & GYOU2).Select ActiveSheet.Paste Application.CutCopyMode = False End Sub

  • EXCEL　VBA 早く処理をする

    よろしくお願いします 下の構文を標準モジュールに書き込み、callで実行しているのですが 処理に時間がかかります。 処理を早くする方法と構文の簡素化のご教示をお願いします。 Application.ScreenUpdating = False For i = 1 To 12 With Worksheets(i) .Select LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A8:G" & LastRow).Sort Key1:=Range("A8"), order1:=xlAscending .Range("G8:G" & LastRow - 1).Formula = "=G7+E8-F8" LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A" & LastRow).Select Dim EndRow As Long EndRow = .Range("A" & Rows.Count).End(xlUp).Row Cells(Rows.Count, 1).End(xlUp).Offset(1, 3) = .Name & "合計" Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) = Application.WorksheetFunction.Sum(Range("E7:E" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) = Application.WorksheetFunction.Sum(Range("F7:F" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(2, 3) = "前月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) = .Range("G7") Cells(Rows.Count, 1).End(xlUp).Offset(2, 5) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 4) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 3) = "次月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(4, 3) = "合計" Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) - Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(4, 4) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) Cells(Rows.Count, 1).End(xlUp).Offset(4, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(1, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(2, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(4, 6) = Cells(Rows.Count, 1).End(xlUp).Offset(0, 6) .Range("C7").End(xlDown).Select Selection.Offset(4, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 2).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 3).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 4).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(0, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 2).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 3).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 4).Borders(xlEdgeBottom).Weight = xlThin End With Next i Application.ScreenUpdating = True

  • VBA 最終行を選んだシートにコピーする。

    VBAど初心者です。どうしても最終行のデータを選んだシートにコピーできません。 LastRow.Selectのところで、止まってしまいます。どのように行を設定していいのかさっぱりわかりません。どなたか、ご指導のほどよろしくお願いします。 Sub copy_last_line() Dim LastRow As Long Sheets("Sheet1").Select LastRow = Cells(Rows.Count, 1).End(xlUp).Row LastRow.Select Selection.Copy Sheets("Sheet2").Select Range("A1").Select ActiveSheet.Paste Sheets("Sheet1").Select Range("A1").Select End Sub

  • エクセルVBA　最終行にデータを追加する

    エクセルのユーザーフォームにチェックリストを用意しました CheckBox1～CheckBox5まであり、 CheckBox1をクリック（true）にすると、セルに“あ” CheckBox2をクリック（true）にすると、セルに“い” CheckBox3をクリック（true）にすると、セルに“う” CheckBox4をクリック（true）にすると、セルに“え” CheckBox5をクリック（true）にすると、セルに“お” を反映させようと思っています たとえば、 ・CheckBox1のみクリック（ｔｒｕｅ）で、Ａ１に“あ” ・CheckBox2のみクリック（ｔｒｕｅ）で、Ａ１に“い” ・CheckBox1、CheckBox3をクリック（ｔｒｕｅ）で、Ａ１に“あ”、Ａ２に“う” ・CheckBox２～CheckBox5をクリック（ｔｒｕｅ）で、Ａ１に“い“、Ａ２に“う“、Ａ３に”え”、Ａ４に“お” といった感じで、選んだチェック項目について、Ａ列においてＡ１から次々とデータを入力しようとしています そこで、 sheets1.Range("Ａ:Ａ").Clear If CheckBox1.Value = True Then sheets1.Cells(Rows.Count, 1).End(xlUp) = "あ" End If If CheckBox2.Value = True Then sheets1.Cells(Rows.Count, 1).End(xlUp) = "い" End If If CheckBox3.Value = True Then sheets1.Cells(Rows.Count, 1).End(xlUp) = "う" End If If CheckBox4.Value = True Then sheets1.Cells(Rows.Count, 1).End(xlUp) = "え" End If If CheckBox5.Value = True Then sheets1.Cells(Rows.Count, 1).End(xlUp) = "お" End If としました （実際は、CheckBoxの名前が1～5と数字ではないので、ｆｏｒは使いませんでした） すると、 CheckBox1～CheckBox5を全てクリック（ｔｒｕｅ）しても、Ａ１に“お”が反映されるだけで“あ”～”え”が入力されません どうすれば、思い通りになるのでしょうか 初歩的な質問だと思うのですが、よろしくお願いします

  • ＶＢＡ　任意のシートからコピーを始める。

    教えてください。 全てのシートをコピーして一つのシートにまとめるプログラムシートを作成しました。 1番目のシートからコピーを始める場合は For i = 2 To Worksheets.Count 2番目のシートからコピーを始める場合は For i = 3 To Worksheets.Count とすればよいのですがこれだといちいちモジュールコードを出して数字を変更しなければならず面倒です。 そこでユーザーフォームのコンボボックスに任意の数字を入れてクリックを押せば希望するシートからコピーを始めるプログラムを作成してみましたがうまくいきません。どなたか教えてくださいませんか。 Sub matome() Dim i As Integer Dim lRow As Long, lCol As Long, lRow2 As Long, lRow3 As Long, SNo As Integer '----何番目からコピーを始めるかを決定します With UserForm2 SNo = .ComboBox1.value End With For i = 1 + SNo To Worksheets.Count With Worksheets(i) lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 lCol = .Cells(1, Columns.Count).End(xlToLeft).Column '----シートのデータが2行以上の場合にコピーします If lRow >= 2 Then lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 If lRow2 < Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 Then lRow2 = Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 .Activate .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1) End If End With Next i

  • エクセル VBA 特定文字がある行を別シートに移動

    ソフト　excel2003 Ｉ列（赤枠部分）に文字列が入力された表があります。 マクロ実行時下記のようにするには、VBAのコードをどのように記入すればよろしいでしょうか？ 『　△　』ボタンをクリックすると シート１の赤枠内のセルに△が入力されている行を切り取りしシート2に貼り付け （下の行は上方向にシフト） 『　×　』ボタンをクリックすると シート１の赤枠内のセルに×が入力されている行を切り取りしシート3に貼り付け （下の行は上方向にシフト） ※　シート１の内容は日毎に更新されますので、更新後、『　△　』ボタンをクリックするとその時点で△が入力されているものはシート２のリストへ追加され、『　×　』ボタンをクリックすると×が入力されているものはシート3のリストへ追加されるようにしたいです。 急ぎの仕事なので、困っています。 宜しくお願い致します。

  • Excel 2007 マクロ 別シートの情報を反映する方法

    Excel 2007 マクロ 別シートの情報を反映する方法 Sheet1とSheet2があります。 Sheet1のD列とSheet2のM列で同じ値があれば、 Sheet1のE列の値をSheet2のN列に反映するマクロを 作成しました。 下記が正しいと思っていたのですが、エラーメッセージは出ずに 値が反映されません。 マクロに問題点があればご指摘ください。 よろしくお願いいたします。 Sub Rist() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") For i = 2 To ws1.Cells(Rows.Count, "D").End(xlUp).Row For j = 2 To ws2.Cells(Rows.Count, "M").End(xlUp).Row If ws2.Cells(j, "M") = ws1.Cells(i, "D") Then ws2.Cells(j, "N") = ws1.Cells(i, "E") End If Next j Next i End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する