Excelマクロの使い方！初心者でも簡単にセルのレコードをコピーする方法
- Excelのマクロを使ってセルのレコードをコピーする方法について教えてください。
- 上記のマクロでは検索を行った後にクリックしたセルのレコードをコピーすることができましたが、検索を使わずに直接コピーする方法はありますか？
- マクロ初心者ですが、Excelのマクロを使って元のSheetのクリックしたセルのレコード全体を別のSheetにコピーする方法を教えてください。
- ベストアンサー
Excelのマクロを教えてください。
マクロの超初心者ですが、よろしくお願いします。 サンプルからですが、 Sub 検索() myWord = Range("C2").Value Set myData = Range("A5:D155") Set myRng = myData.Find(myWord) If Not myRng Is Nothing Then Application.Goto Cells(myRng.Row, 1), True End If End Sub Sub コピー() 'Set myData = Range("A5:D155") Set motorng = Application.Intersect(myData, ActiveCell.EntireRow) Set sakiRng = Sheets("抽出").Range("B65535").End(xlUp).Offset(1) motorng.Copy sakiRng End Sub 以上のうち、「コピー」の部分をについて質問ですが、「検索」を使わないで、元Sheetのクリックしたセルのレコード全体を取得してSheets("抽出")にコピーする方法はないでしょうか。 上記のマクロでは一旦「検索」を行った後では「検索」を実行しなくてもクリックしたセルのレコード全体をSheets("抽出")にコピー出来ましたので、検索の部分を削除したいのですが。 説明が下手でスミマセンが何卒よろしくお願いします。
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
こんな意味でしょうか？ Sub Test() Dim motoRng As Range, sakiRng As Range Set motoRng = Application.Intersect _ (ActiveCell.EntireRow, ActiveCell.CurrentRegion) Set sakiRng = Sheets("抽出").Range("B65535").End(xlUp).Offset(1) motoRng.Copy Destination:=sakiRng End Sub
関連するQ&A
- VBAのファインドメソッドで検索すると対象外のデータが選択されることがある
CDのリスト表（12列で、現在2269行 範囲名"収録表"）Sheets("データ")から,キーワードで該当ディスクを検索し、 結果をSheets("検索")に転記する、プログラムを作りましたが、 仮に、該当データが10件、転記されたとして そのデータを見ると、中に1件、対象外のデータがはいっている事が たまにあります、いろんな原因を考えてみましたがわかりません。 もともと、VBAのファインドメソッドが、こんなエラーを起こしやすいのか、、、（そんな事、ないよね） どなたか、教えてください。 下が、プログラムです Sub 新規検索() Application.ScreenUpdating = False Dim myData, myRng As Range Dim myWord As String myWord = InputBox("キーワードを入力してください") データ処理中F.Show vbModeless データ処理中F.Repaint Set myData = Range("収録表") Set myRng = myData.Find(What:=myWord, LookIn:=xlValues, _ Lookat:=xlPart, MatchCase:=False, MatchByte:=False) If myWord = "" Then MsgBox ("キーワードを入力してください") Exit Sub End If If Not myRng Is Nothing Then Application.Goto Cells(myRng.Row, 1), True Else: Unload データ処理中F MsgBox ("該当データはありません") Exit Sub End If Sheets("検索").Range("K1") = myRng.Row '一番最初の検索値のRow Call コピー1 Do Until Range("K1") = Range("L1") Call 次を検索 Loop Call 検索終了 Unload データ処理中F Application.ScreenUpdating = True End Sub Sub 次を検索() Dim myData, myRng As Range Sheets("データ").Select Set myData = Range("収録表") Set myRng = Cells.FindNext(after:=ActiveCell.Offset(1)) If myRng <> "" Then Application.Goto Cells(myRng.Row, 1), True End If Sheets("検索").Range("L1") = myRng.Row '2番目以降の検索値のRow Call コピー2 End Sub Sub コピー1() Sheets("検索").Range("A3:L5000,L1").ClearContents Dim myData As Range Set myData = Range("収録表") Set motorng = Application.Intersect(myData, ActiveCell.EntireRow) Set sakiRng = Sheets("検索").Range("A65535").End(xlUp).Offset(1) motorng.Copy sakiRng Sheets("検索").Visible = True Sheets("検索").Activate End Sub Sub コピー2() Dim myData As Range Set myData = Range("収録表") Set motorng = Application.Intersect(myData, ActiveCell.EntireRow) Set sakiRng = Sheets("検索").Range("A65535").End(xlUp).Offset(1) motorng.Copy sakiRng Sheets("検索").Visible = True Sheets("検索").Activate End Sub Sub 検索終了() Dim r As Long r = Range("A65536").End(xlUp).Row Range("A" & r).Select ActiveCell.FormulaR1C1 = "=COUNTA(R3C:R[-1]C)" MsgBox "全部で" & Range("A" & r).Value & "件ありました" Range("A65535").End(xlUp).EntireRow.ClearContents Call 行頭表示 End Sub
- ベストアンサー
- オフィス系ソフト
- 転記の際に重複を避けたいのですが・・・（エクセル）
マクロ初心者です。 宜しくお願いします。 Sub 転記開始() Set MotoSht = Sheets("表示シート") Set SakiSht = Sheets("データ") MotoArray = Array("C5", "F5", "C6", "C7", "C8", "F6", "C9", "F9", "C10", ・・・・) Set sakiRng = SakiSht.Range("A65535").End(xlUp).Offset(1) i = 0 For Each myRng In MotoArray sakiRng.Offset(, i) = MotoSht.Range(MotoArray(i)) i = i + 1 Next End Sub 以上ですと、Sheets("データ")にすでに転記したデータがあってもマクロを実行するたびに同じデータが蓄積されていきます。 そこで、 Sheets("データ")にSheets("表示シート") の"C5"と同じデータが有る場合は同じレコードに上書きをするようにしたいのですが、何か方法が有りましたら宜しくご指導をお願います。
- 締切済み
- オフィス系ソフト
- エクセルのデータの変更
今マクロでSheet1にあるデーターをSheet２・３・４・５・６・７それぞれにそれぞれの抽出条件で抽出できるよう設定してあるのですが、このSheet１を他のBookに変更した場合のマクロの変更の仕方を教えてください。 ちなみにいまは 標準モジュールに Sub 定義() Dim myTbl As Range, myQry As Range, sakiRng As Range End Sub と各シートの[Worksheet Activate] に Private Sub Worksheet_Activate() Set myTbl = Sheets(１).Range("myTbl") Set myQry = Sheets(８).Range("A_抽出条件") Set sakiRng = Sheets(２).Range("A3：AR3") myTbl.AdvancedFilter xlFilterCopy, myQry, sakiRng Dim rw As Long '入力最終行 rw = Range("I65536").End(xlUp).Row With Application Range("I" & rw + 1) = .Sum(Range("I1:I" & rw)) Range("AO" & rw + 1) = .SumIf(Range("AP1:AP" & rw), "済", Range("AO1:AO" & rw)) Range("AQ" & rw + 1) = .Sum(Range("AQ1:AQ" & rw)) End With End Sub となっています。
- 締切済み
- オフィス系ソフト
- Excelのマクロについて
文字列から数値だけを抽出するマクロを見つけたのですが、抽出するデータを選択してから実行しなければなりませんでした。 抽出するデータはAセル以下にしかないので、データを選択しないでも実行できるようにするにはどうしたら良いのでしょうか？ 宜しくお願いします。 以下見つけたマクロです。 Sub test() Dim mydata As String Dim c As Range Dim i As Integer For Each c In Selection mydata = "" For i = 1 To Len(c) If Mid(c, i, 1) >= 0 And Mid(c, i, 1) <= 9 Then mydata = mydata & Mid(c, i, 1) End If Next c.Offset(0, 1) = mydata Next End Sub
- 締切済み
- オフィス系ソフト
- VBAでオートフィルを使って指定する文字列を含むものを表示させたい
VBAを使って、セルD1に入力した文字列を検索するマクロを作りたいと思っています。 私は初心者で前に似たようなものを作ってもらって それを加工しようとしたのですが、うまくいきませんでした。 以前は完全に一致するもので表示でしたが、 今回は含むものを表示させたいです。 ワイルドカードは＊をつけるのはわかるのですが、 いろいろやってみましたがダメでした。（単純なことかもしれないですけど） Private Sub Worksheet_Change(ByVal Target As Range) Dim myRng1 As Range Dim myRng2 As Range Set myRng1 = Target.Cells(1) If Application.Intersect(myRng1, Range("D1")) Is Nothing Then Exit Sub Set myRng2 = Range("D1").CurrentRegion With myRng2 If myRng1 = "" Then ActiveSheet.ShowAllData Else .AutoFilter Field:=4, Criteria1:=myRng1.Value End If End With End Sub
- 締切済み
- その他（プログラミング・開発）
- Excelマクロ オートフィルター条件設定で不等号を使いたい
Excelマクロ オートフィルター条件設定で不等号を使いたい 請求シートより抽出条件シートに条件を設定し、抽出シートにコピーするマクロ を作成しています。 抽出条件に比較演算子の不等号<>を使った場合、条件が無視されてしまいます。 どのようにしたら良いでしょうか？ 請求シートのA列には会社番号が数字4桁で入力されています。 抽出条件シートA5セルに下記の条件を設定した場合、 1と2の場合は上手くフィルターが機能しますが、3の不等号を 使った場合は機能しません。どなたか宜しくお願いします。 1：1000 2：>1000 3：<>1000 Sub テスト() Dim LastRow As Long, LastColumn As Long Dim myData As Range Dim myCriteria As Range With Worksheets("請求") LastColumn = .Cells(5, Application.Columns.Count).End(xlToLeft).Column LastRow = .Cells(Application.Rows.Count, "A").End(xlUp).Row Set myData = .Range("A5", .Cells(LastRow, LastColumn)) End With Set myCriteria = Worksheets("抽出条件").Range("A5").CurrentRegion Worksheets("抽出").Range("A6:R1000").ClearContents myData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=myCriteria, _ CopyToRange:=Worksheets("抽出").Range("A5:R5"), Unique:=False Set myData = Nothing Set myCriteria = Nothing End Sub
- ベストアンサー
- その他MS Office製品
- ブック全体の検索の次へは？
ブック全体を検索するマクロ作ったのですが、 ブックの最初にあるものしか見つけられません。 見つかった時に、次の検索を行うにはどのようなＶＢＡになるのでしょうか？ よろしくお願いもうしあげます。 Sub KensakuAll() 'ブック内の全シートを検索 Dim myWb As Workbook Dim mySht As Worksheet Dim myRng As Range Dim Key1 As String Key1 = InputBox("検索キーを入力しなさい") If Key1 = "" Then Exit Sub For Each mySht In Sheets Set myRng = mySht.Cells.Find(what:=Key1) If Not myRng Is Nothing Then mySht.Activate myRng.Activate Set mySht = Nothing Set myRng = Nothing Exit Sub End If Next MsgBox "該当するセルは見つかりませんでした" Set mySht = Nothing Set myRng = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
- 転記したデータを基にして検索表示させる方法
下記のようにシートＡのデータをシートＢ（Ａ列）へ転記した後に、転記したデータを基にしてデータベースから検索した結果をシートＢ（Ｂ列）に表示したいのですが、マクロを実行すると「型が一致しません」というエラーになります。 どのようにしたらエラーにならないのか… どうぞよろしくお願いします。 Sub レコード転記() Dim myTbl As Range, sakiRng As Range Set myTbl = Sheets("Ａ").Range("B6:B81") Set sakiRng = Sheets("Ｂ").Range("A5") myTbl.Copy sakiRng.PasteSpecial xlPasteAll sakiRng.PasteSpecial xlPasteColumnWidths End Sub Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim r As Variant, myRange As Range Set myRange = Workbooks("入力フォーム.xls").Worksheets("一覧表").Range("社名") With Target If Target.Column = 1 Then r = Application.WorksheetFunction _ .Match(Target.Value, myRange, 0) Cells(Target.Row, 2) = Workbooks("入力フォーム.xls").Worksheets("一覧表").Range("N1").Offset(r - 1).Value End If End With End Sub
- ベストアンサー
- Visual Basic
- 二つのマクロで一気に処理したい
以下のようなことができるのかお伺い致します。よろしくお願い致します。 やりたいこと ※ 前提として、sheet1にすでにA列に通し番号で奇数の数字が入っている。 1.sheet1からsheet2へコピペーストする。しかし、A列からO列のすべてにデータがあった場合のみコピー貼り付けさせたい。 (前提で示したように、A列に通し番号で奇数の数字が入っていて、A列のみ数字があり、以外が空欄の行があるため) 2.下記のコピー貼り付けのコードと重複削除のコードを合体させて、一つの処理で動かしたい。 Sub コピー貼り付けつけ() 'コピー貼り付けつけのコード Dim lastRow As Long 'Sheet1のA3から最終行までをコピー With Sheets("sheet1") .Range("A3:O" & .Cells(Rows.Count, "A").End(xlUp).Row).Copy End With 'Sheet2のA列の最終行の次の行に貼付け Sheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Application.CutCopyMode = False End Sub Sub 重複データを一括削除する() ' Macro1 Macro Dim i As Long, lastRow As Long, myRng As Range LastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = 1 To lastRow - 1 If WorksheetFunction.CountIf(Range(Cells(i + 1, "O"), Cells(lastRow, "O")), Cells(i, "O")) > 0 Then If myRng Is Nothing Then Set myRng = Cells(i, "O") Else Set myRng = Union(myRng, Cells(i, "O")) End If End If Next i If Not myRng Is Nothing Then myRng.EntireRow.Delete End If End Sub
- ベストアンサー
- Visual Basic
- マクロの修正ができません
エクセルのマクロで下記の作業をしています。 よくわからないまま使っているので障害箇所がわかりません。 教えていただけないでしょうか・・ 説明の仕方も下手で申し訳ありませんがよろしくお願いいたします。 [マクロの用途] ・別シートに請求データを作成しています。 ・請求番号を入力するセルに請求番号を入力します。 ・登録したマクロボタンを押すと抽出範囲に該当する請求書のデータが抽出されます。 [障害の内容] 請求データが４行以上になると、３行まで抽出され、 ４行以降は抽出されません。 以下はマクロの内容です。 Sub 抽出() ' ' 抽出 Macro ' マクロ記録日 : 2007/2/19 ユーザー名 : ＊＊＊' Dim myRow1 As Long, myRow2 As Long myRow1 = Sheets("データ").Range("B65536").End(xlUp).Row myRow2 = Sheets("抽出範囲").Range("B65536").End(xlUp).Row If myRow2 >= 5 Then Sheets("抽出範囲").Range("A4:Q40" & myRow2).ClearContents End If Sheets("データ").Columns("A:Q").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A4:Q40"), Unique:=True End Sub
- ベストアンサー
- オフィス系ソフト
お礼
お礼が遅くなりましてスミマセンでした。 まさに、まさに素晴らしいです。。 感激しています。 大変ありがとうございました。