Excelセルにデータをコピーする方法とVBAコード

このQ&Aのポイント
  • Excelのセルにデータをコピーする方法と、VBAコードを使用して特定の曜日のデータを入力する方法について説明します。
  • A1セルに日付を入力し、入力ボタンを押すと、A2〜A11のセルに特定の曜日のデータが入力される方法について、ExcelとVBAを使用して詳しく解説します。
  • ExcelのVBAコードを使用して日付が変更されるごとに、特定の曜日のデータが入力されるようにする方法について説明します。入力ボタンを押すたびに、A2〜A11のセルが曜日ごとのデータに自動的に変更されます。
回答を見る
  • ベストアンサー

曜日別Excelセルにデータコピー

A1セルに2014/3/18と入力した際、入力ボタンで図のようにA2~A11に下記の式で火曜日のデーターE2~E11が入力出来たのですがA1の日付(曜日)を変更した際、入力ボタンを押すごとにA2~A11の値がその曜日ごとのデーターに変わるようにしたいのですが。VBAコードをお解りになる方よろしくお願いします。 Sub 入力() ActiveCell.Value = Range("D2:D11").Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.1

こんばんは! 一例です。 Dim c As Range, str As String str = Format(Range("A1"), "aaaa") Set c = Range("C1:H1").Find(what:=str, LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then '←念のため Cells(2, c.Column).Resize(10).Copy Range("A2") End If こんな感じではどうでしょうか? ※ 画像では土曜日までのようですので、H列までの検索としています。m(_ _)m

関連するQ&A

  • 指定セルをコピー

    A2~A5,D2~D5,G2~G5をコピーしJ~P列2~5行に値を貼付け続いて9~13行、16~20行もJ~P列に貼り付けたいのですが7~8,14~15行にはセル結合されているところもあります。VBAで下記コードを入力しましたがあまりにデータが多く何か良い方法VBAコードはありますか。(For~Nextなど使用すれば良いのでしょうか) 環境はoffice2013です。 Range("A2:A6").Select Selection.Copy Range("J2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D2:D6").Select Selection.Copy Range("M2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False  Application.CutCopyMode = False

  • VBA セルの値を別セルにコピーするには

    VBAでPastespecialでセルの値を別セルにコピーするマクロを組みたいです。 以下は参考にしたソースコードです。 Worksheets("Sheet1").Range("A1:B10").Copy Worksheets("Sheet2").Range("A1").PasteSpecial _                  Paste:=xlPasteValues, _                  Operation:=xlNone, _                  SkipBlanks:=False, _                  Transpose:=False あるExcelマクロの入力フォームSheetに、製品リストと使用している場所のマスタデータをクエリで読み込んで、製品IDと場所のコードを入力したらINDEX関数で抽出し、マクロ実行ボタンを押すと抽出結果を入力フォームの入力欄に貼り付けします。 上記のマクロだと貼り付けする元セルを移動させたら内容がずれた値がそのまま貼り付けされてしまうと思われますが、地道にコードのコピー元のセルを書き直さないといけないのでしょうか。 Excelの関数だと参照範囲を固定したら掴んで移動させてもセル番地が連動して移動してくれますが、マクロの場合どのようにすれば良いでしょうか。 また、複数個所のセルをコピーするので Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False をコピーするセルの箇所に毎回入れていますが、コピー元のセル・コピー先のセル番地を一括して実行する方法はありますでしょうか。 VBAはソースコードを参考に当てはめているだけで、自力でコードを書くスキルは皆無です。 Excelは2016です。 詳しい方いましたらご教授ください。よろしくお願い致します。

  • 形式を選択して貼り付け

    Range("a" + z + 1).PasteSpecial_ Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=True 上記を入力し、実行すると「この操作には同じサイズの結合が必要です」とエラーが出ます。本を見て同じように作成したので、何処が間違ってるのか、分かりません。教えて下さい。

  • セルの選択

    よろしくお願いします。 AE1:AI15の中のあるセル(6桁の値が入っています)を選択している状態から始まりまり、セルAA3に貼り付け、別のマクロ(検索)を実行後、また元のセルにマクロで戻りたいのですが、 どなたか詳しい方教えて下さい、よろしくお願いします。 Private Sub CommandButton2_Click() '検索ボタン Application.ScreenUpdating = False Selection.Copy Range("AA3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False 検索 End Sub

  • エクセル マクロ コマンドボタンで行をコピーエラー

    教えてください。 sheet2にコマンドボタンを作成し、コードを下記の通りに入力しました。 ボタンを押すと「RangeクラスのSelectメソッドが失敗しました。」とエラー表示され デバックを見るとRows("1:1").Selectが原因みたいですが、どのように手直ししたら いいか教えて頂けないでしょうか。 Private Sub CommandButton1_Click() Sheets("Sheet1").Select Rows("1:1").Select Selection.Copy Sheets("Sheet2").Select Rows("20:20").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub

  • セルの値で別BookのSheetを開く

    EXCELのVBAで、特定のBook(元データ.xls)のA1セルに入力された文字列と同じ名前の別Book(format.xls)のSheet(元データ)を開くようにしたいのですがうまくいきません。 VBAはほぼ素人で、いろいろなページを参考につぎはぎで作りました。 どうか、宜しくお願いします。。。 Dim a As String a = Workbooks(\"元データ.xls\").Worksheets(\"Sheet1\").Cells(1, 1).Value ActiveCell.FormulaR1C1 = \"=LEFT(bookname(),FIND(\"\".\"\",bookname())-1)\" Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False   >> 元データ.xlsのA1にはファイル名を取得(除く.xls)して、値貼り付けするようにしています。          Workbooks(\"format.xls\").Activate Worksheets(a).Select     ↑ココがうまく行かないようです。 が、一度失敗して2回目は上手く動きます。なぜなのかわかりません。

  • Excelでマクロを繰り返したい。

    Excelでマクロを記録したら以下のようになりました このマクロを以下の条件で繰り返したいのですが。 Sub Macro1() '------------- '----------------------- ' Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=5*", Operator:=xlAnd, _ Criteria2:="<>5@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=6*", Operator:=xlAnd, _ Criteria2:="<>6@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=7*", Operator:=xlAnd, _ Criteria2:="<>7@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=8*", Operator:=xlAnd, _ Criteria2:="<>8@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub 条件= Field:は4~35位まで変動します 一連の動作をコピーして手作業で数字を変えてみたのですが プロージャが大きすぎてエラーになってしまいます。 何か良い方法は無いでしょうか?。

  • 【Excel VBA】シートコピー時、マクロコードはコピーしたくない

    ws.copy Before:=Workbooks(File).Sheets(1) Windows(File).Activate Cells.Select Selection.copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 上記コードで、シートのコピー・貼付を行っていますが、 コピー元シートのコードも引き継がれてしまいます。 引き継がれないようにコピーしたいのですが、可能でしょうか? 可不可について、 可能ならばそのやり方(コード)を教えていただけないでしょうか? よろしくお願いします。

  • Excelのマクロ 検索範囲を広げたい

    マクロ初心者です。 マクロが入ってるExcelファイルがあるのですが、 マクロボタンを押しても結果がでないので、たぶんマクロの検索範囲が1列しかなってないみたいなので広げたいのですが、どうしたらよいでしょうか? Sub 検索準備() ' ' 検索準備 Macro ' ' Sheets("データ表").Select Range("A3:ES2002").Select Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin, DataOption1:=xlSortNormal Sheets("検索表").Select Range("A4").Select ActiveCell.FormulaR1C1 = "=+R[1]C" Range("A4").Select Selection.Copy Range("B4:ES4").Select Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Sheets("個人スキル").Select Range("D3:E3").Select End Sub Sub スキル検索() ' ' スキル検索 Macro ' ' ' Sheets("検索表").Select Range("A4:ES4").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1:ES4").Select Application.CutCopyMode = False Selection.Copy Sheets("計算表").Select ActiveWindow.SmallScroll ToRight:=-3 Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True Range("F1:J149").Select Application.CutCopyMode = False Selection.Copy Range("L1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll ToRight:=4 Range("L13:P149").Select Application.CutCopyMode = False Selection.Sort Key1:=Range("L13"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin, DataOption1:=xlSortNormal Range("L23").Select Sheets("個人スキル").Select Range("D3:E3").Select End Sub 検索準備ボタンと、スキル検索2種類ボタンがあります。 どこをいじくればよいのか分かりません。 検索表の検索範囲が表題を抜かして人の名前などが入ってる列が1列しかなってないので・・・

  • マクロについて教えてください

    マクロの超初心者です。 数式を入力しているのではなく、配付物をエクセルで作成しているのですが、同じもの(氏名や項目は違いますが)を100枚ほど作成しているのでマクロを・・・と思ったのですがやり方が全く分かりません。 sheet1からsheet2に下記のようにデータを写したいのですが、やり方を教えてください。 ●氏名が入力されています sheet1(A9) → sheet2(C2) sheet1(E9) → sheet2(C5) sheet1(I9) → sheet2(C8) ●項目1 sheet1(A8) → sheet2(E3) sheet1(E8) → sheet2(E6) sheet1(I8) → sheet2(E9) ●項目2 sheet1(A18~D18の結合セル) → sheet2(E2) sheet1(E18~H18の結合セル) → sheet2(E5) sheet1(I18~L18の結合セル) → sheet2(E8) と反映させたいのですが、250行あるのですが、 簡単にマクロで出来ないでしょうか?? ちなみに↓コレが上記の内容で作ってみたものです。 わかりずらい質問でスイマセン。 Range("A9").Select Selection.Copy Sheets("sheet2").Select Range("C2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E3").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E6").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E9").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A18:D18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E18:H18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I18:L18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End Sub

専門家に質問してみよう