• ベストアンサー

エクセル2003のVBAについて

次のコードのように、初めにクリックしたセルに、次にクリックしたセルの内容をコピーするVBAを書いたのですが、コピー先の列を、複数指定する方法がわかりません。 たとえば、C~O列(3~15)のように指定できればと思っています。 このようなことは可能でしょうか? ご教授いただけます方、よろしくお願い申し上げます。 -------------------------------------------------- Dim FrstCell As Range Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.MergeCells = False And Target.Count > 2 Then Exit Sub On Error Resume Next '想定しないエラーを無視 If Target.Cells(1) = "" Then If Target.Column <> 3 Then Exit Sub 'C列 コピー先 Set FrstCell = Target.Cells(1) Else If Target.Column <> 18 Then Exit Sub 'R列 コピー元 Target.Copy FrstCell.MergeArea End If On Error GoTo 0 'エラートラップ終了 End Sub

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

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんばんは。 >たとえば、C~O列(3~15)のように指定できればと思っています。 If Target.Column <> 3 Then Exit Sub 'C列 コピー先     ↓ If Intersect(Target, Range("C1:O1").EntireColumn) Is Nothing Then Exit Sub 'C列 コピー先 このように書き換えればよいと思います。

ein-zwei
質問者

お礼

できました!完璧です!ご回答りがとうございました!

その他の回答 (1)

回答No.1

普通に考えれば Copy メソッドでコピー元のセルを指定して PasteSpecial メソッドで範囲指定すればいいのでは。 と、思いますが。

関連するQ&A

  • エクセルVBAについて

    エクセルVBAについて 下ような、最初に選択したセルに、次に選択したセルをコピーするマクロを使用しています。 Dim Frstcell As Range Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.MergeCells = False And Target.Count > 1 Then Exit Sub On Error Resume Next 'エラーを無視 If Target.Column >= 5 And Target.Column <= 35 Then 'E:AIコピー先 Set Frstcell = Target.Cells(1) ElseIf Target.Column >= 45 And Target.Column <= 46 Then 'AS:ATコピー元 If Target.Cells(1).Value = "" Then Exit Sub Target.Copy Frstcell.MergeArea End If On Error GoTo 0 'エラートラップ終了 End Sub この場合、コピー元の枠線の書式も、コピー先にコピーされてしまうのですが、 書式なしでコピーするにはどうしたらよいでしょうか? よい方法がありましたら、よろしくお願いいたします。

  • エクセル2003のVBAについて

    このような文にて、先にクリックしたセルに、次にクリックしたセルの内容をコピーさせています。 ----------------------------------- Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.MergeCells = False And Target.Count > 1 Then Exit Sub On Error Resume Next '想定しないエラーを無視 If Target.Cells(1) = "" Then If Intersect(Target, Range("C1:O1").EntireColumn) Is Nothing Then Exit Sub 'C~O列 コピー先 Set FrstCell = Target.Cells(1) Else If Target.Column <> 19 Then Exit Sub 'S列 コピー元 Target.Copy FrstCell.MergeArea End If On Error GoTo 0 'エラートラップ終了 End Sub --------------------------------------- そこで、例えば同じシートモジュール内に、このような記述を2つして、 1つ目と、2つ目のコピー元とコピー先の列を別々に指定することは可能でしょうか? 「IF文のハシゴ」という言葉もヒントに試してもみたのですがうまくいきません。 たとえば、1つ目の文では、コピー元はA列、コピー先はC~E列に 2つ目の文ではコピー元はF列、コピー先はH~J列 というように指定できればと思っています。 また、この文を元に、コピー元とコピー先の範囲指定が、複数できれば、方法は問いません。 どうぞ、よろしくお願い申し上げます。

  • VBAについて教えて下さい。

    エクセル2003を使用してます。 ("Sheet1")のB列をダブルクリックすると、 ("Sheet2")の("AA100")を表示するようにしたいのですが、 ■の部分がエラーが出て、色々変更して試してるのですが駄目です。 どう言う風に、書けばいいのかわかりません。 どなたか教えて頂けませんか? 下記VBAです。 ──────────────────────────────── Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Target.Column <> 2 Then Exit Sub Sheets("Sheet2").Activate ■Range("AA100").Select End Sub ──────────────────────────────── よろしくお願いします。

  • エクセルVBAについて

    http://okwave.jp/qa/q7236213.html 上記質問の発展形なのですが 同様のことを E列に日付 F列に売上 G列に結果 でやりたいのですが この時A列~C列のマクロも残したままでしたいのですが 下記のように同様のプロシージャーを下段に書けばできると思ったのですが うまくいきません。 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$A$1" Then Exit Sub If Target = "" Then Exit Sub Range("C10:C65536").ClearContents With Range(Cells(9 + Range("A1").Value, "C"), Cells(Range("A65536").End(xlUp).Row, "C")) .FormulaR1C1 = "=MAX(RC2:R[" & -Range("A1").Value + 1 & "]C2,FALSE)" .Value = .Value End With End Sub Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$E$1" Then Exit Sub If Target = "" Then Exit Sub Range("G10:G65536").ClearContents With Range(Cells(9 + Range("E1").Value, "G"), Cells(Range("E65536").End(xlUp).Row, "G")) .FormulaR1C1 = "=MAX(RC6:R[" & -Range("A1").Value + 1 & "]C6,FALSE)" .Value = .Value End With End Sub どなたかお知恵を拝借できませんでしょうか?

  • エクセルVBAについて

    エクセルVBAについて 下にある、1行目に入力された数値の、選択したセルの数値を、B5セルに表示させるマクロなのですが、1行目が結合していると、うまくB5セルに表示できません。 Private Sub Worksheet_SelectionChange(ByVal Target As Range)  If Target.Count > 1 Then Exit Sub    '●複数セル選択は無視  If Target.Row <> 1 Then Exit Sub    '●1行目以外の選択は無視  If Target.Column > 6 Then Exit Sub   '●F列目以降の選択は無視  If Target.Value = "" Then Exit Sub   '●選択セルが未入力なら無視    Range("B5").Value = Target.Value End Sub このマクロで、結合しているセルをB5に表示させることはできますでしょうか? 1行目で選択するセルは、すべて2つのセルが結合しています。 よろしくお願いいたします。

  • エクセル2003 VBAでセル移動

    いつもお世話になります。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Row > 9 Then If Target.Column = 3 Then Cells(Target.Row, 4).Select ElseIf Target.Column > 5 Then Cells(Target.Row + 1, 1).Select End If End If End Sub これで、B列からC列を飛ばしてD列にセル移動して取りあえずの目的は達成しているのですが、 D列からB列には方向キー移動してくれません。Target.Columnが3になるんで当たり前なんですが・・・ B列の入力ミスがあるときマウスで移動させるか、A列まで戻ってから方向キーで上に上がるかです。 何かいい方法ありませんでしょうか。D列から方向キーで戻るときも、出来ればC列を飛ばしてほしいです。 よろしくお願いします。

  • VBAでコードの編集が上手くいきません

    先日、ご回答頂いたコードを元に自分でいじっているのですが上手く行きません 自分が変更したコード シート1→シート名:変更箇所 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$C$40" Then Exit Sub If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target.Address <> "$C$42" Then Exit Sub If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target.Address <> "$C$44" Then Exit Sub If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value End Sub シート2→シート名:リスト Private Sub worksheet_change(ByVal Target As Excel.Range) Dim i As Long, c As Long Dim h As Range, ha As Range Dim myDic As Object Set ha = Application.Intersect(Target, Range("A:C")) If ha Is Nothing Then Exit Sub Set ha = Application.Intersect(ha.EntireColumn, Range("1:1")) For Each h In ha Set myDic = CreateObject("Scripting.Dictionary") If h.Column = 1 Then c = 3 'A列→C列 If h.Column = 2 Then c = 4 'B列→D列 If h.Column = 3 Then c = 6 'C列→F列 On Error Resume Next For i = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row If Cells(i, h.Column) <> "" Then myDic.Add Cells(i, h.Column).Value, Cells(i, h.Column).Value End If Next i With Worksheets("変更箇所").Cells(40, c).EntireColumn.Validation .Delete .Add Type:=xlValidateList, Formula1:=Join(myDic.keys, ",") End With Set myDic = Nothing Next End Sub シート1において$C$40または$C$42または$C$44のいずれかを変更した場合 最後に変更したセルに対し、シート2にオートフィルタ―がかかる様にしたいと思っています。 試しにシート1を以下のように編集したところ、思った動作を行ったのですが $C$40または$C$42または$C$44のいずれかのセルを空白にすると エラーがでてしまいます。 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value End Sub Then Exit Subをどう編集すれば上手く動作するでしょうか?

  • VBAでエラートラップがうまくいきません。

    VBAで次のようなプロシージャを実行してみました。 Private Sub Worksheet_SelectionChange(ByVal Target As Range)   If Target.Value = " " Then          ~コード~   END IF END SUB すると複数のセルが選択されるとエラーがでます。そこで次のようにしてみました。 Private Sub Worksheet_SelectionChange(ByVal Target As Range)   On Error GoTo エラー処理   If Target.Value = " " Then     On Error GoTo 0           ~コード~   END IF   EXIT SUB エラー処理:   EXIT SUB END SUB ところがこれでもやっぱりIF文のところでエラーがでます。 当方初心者でなぜエラーがでるのかわかりません。 わかりやすくご教授ください。 よろしくお願いします。

  • メッセージボックスを表示させるエクセルマクロ

    こんにちは。マクロ初心者です。 エクセル(Excel2003)でメッセージボックスを 表示させるマクロが思うようにいかず困っています。 B列に「○○会社」と入力されれば、 「取引先です。」 とメッセージボックスを表示させたいと思い、 次のとおりマクロを作成しました。 -------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 And Target Like "*会社" Then MsgBox "取引先です。" End If End Sub -------------------------------- しかし、コピーなどで複数のセルを貼り付ける(入力)行為をすると、 「実行エラー'13': 型が一致しません」と出てしまいます。 Worksheet_Change(ByVal Target As Range)を使っているので、 -------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Column = 2 And Target Like "*会社" Then MsgBox "取引先です。" End If End Sub -------------------------------- と、「If Target.Count > 1 Then Exit Sub 」を入れれば、 メッセージは出なくなるのですが、 これだと、A列セルに、コピー&ペーストで複数セルを貼り付けた場合、 「○○会社」があっても、マクロが効いてきません。 複数セルの貼り付けにも対応させるには、 どのようにすればよろしいでしょうか? 基本的なところが理解できていないのだと自覚しておりますが、 どうかご教授願います。 長々とわかりづらい文章ですみません。よろしくお願いします。

  • Excel VBAについて

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub Application.Goto Worksheets("人件費").Range("A1") Worksheets("人件費").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = Target.Offset(, -5).Value cancel = True End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub Application.Goto Worksheets("外注費").Range("A1") Worksheets("外注費").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = Target.Offset(, -5).Value cancel = True End Sub 上の指令はFの列をダブルクリックすると人件費のシートが開いてAある値を人件費の新しいセルのAに代入する指令ですが それをG列ダブルクリックで外注費シートに同じようにやろうと思いましたが出来ません。 たぶん根本的に書き方が間違っているのかと思われますが、ご指導のほどお願いします。

専門家に質問してみよう