プロが教える店舗&オフィスのセキュリティ対策術

Excel チェックボックスにチェックが付いた複数のセルを別のシートにコピー・貼り付けするマクロを教えて下さい。

●マクロにしたい作業
シート1に
A1から下に職員名(150名)が記載されており、C1から下に職員名の数だけチェックボックスがあります。

シート1のチェックボックスにチェックが入っている行の職員名をコピーし、シート2のA1から下に貼り付けたいと思っています。

シート1の職員名が入力されているセルはハイパーリンクで同じブック内のシート(例: セルの職員名が"田中"であれば、同じ名前のシート名"田中")に飛ぶようになっており、その仕様もシート2に引き継ぎたいです。

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

gooドクター

A 回答 (2件)

チェックボックスは何種類かありますが、どの種類?あるいはどういう手順で作成したもの?




下記のフォームコントロールで作成したチェックボックスで、

Be COOL Users - チェックボックスの作り方
https://www.becoolusers.com/excel/checkbox.html

チェックボックスの内容がD1から下にTRUE/FALSEで表示されているなら、
E1:=IF($D1, $A1, "")
以下コピペ。
ってしといて、E列をコピー、値を貼り付けとか。

コピー、貼り付けするのを絶対座標でマクロ記録してれば、繰り返し実行できるハズ。


> ハイパーリンクで同じブック内のシート(~)に飛ぶようになっており、

名前とシート名が一致してるなら、HYPERLINK関数で実装できるハズ。

よねさんのWordとExcelの小部屋 - HYPERLINK関数の使い方:Excel関数
http://www.eurus.dti.ne.jp/~yoneyama/Excel/kansu …
    • good
    • 0
この回答へのお礼

つらい・・・

こんにちは。
回答ありがとうございます。フォームコントロールでチェックボックスを作成しています。分かりづらい説明ですみません。
チェックボックスの内容がD1から下にTRUE/FALSEで表示されていないため、そこから躓いていました。1つ1つセルのリンクを設定していたのですが、同様の作業が必要なブックが多数あり途方に暮れています。

一括でチェックボックスの内容がD1から下にTRUE/FALSEで表示する方法がありますでしょうか??

お礼日時:2020/08/28 16:25

こんにちは、


>Excel チェックボックスにチェックが付いた複数のセルを別のシートにコピー・貼り付けするマクロ

チェックボックスにチェックを付けた時に実行するのは、問題が生じるのでしょうか?
チェックを付けた時であれば、チェックボックスが起点になるので比較的容易ですが、、纏めて行う場合
少々判り難くなります。

不明な点などもありますが、補足をいただいても今日は応じられそうにないので、、実行サンプルを下記に記載します。
チェックボックスは、フォームコントロールで、ペースト先C列に作成されるチェックボックスは貼り付け時に削除します。
ご質問のシート1、シート2がシート名です。

Sub sample()
  'フォームコントロール
  Dim Lc As Long
  Dim celLeft As Long, celTop As Long
  Dim celRight As Long, celBottom As Long
  Dim Rng As Range
  Dim objCB As Object, DelCB As Object

  With Sheets("シート1")
    For Each Rng In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
      Lc = .Cells(Rng.Row, .Columns.Count).End(xlToLeft).Column
      With Rng.Offset(, 2)
        celTop = .Top
        celLeft = .Left
        celBottom = .Top + .Height
        celRight = .Left + .Width
      End With
      For Each objCB In .CheckBoxes
        If celTop <= objCB.Top And celLeft <= objCB.Left And _
            celBottom >= objCB.Top + objCB.Height And celRight >= objCB.Left + objCB.Width Then
          If objCB.Value = xlOn Then
            'メイン処理
            With Sheets("シート2")
              Rng.Resize(, Lc).Copy .Cells(Rows.Count, 1).End(xlUp).Offset(1)
              For Each DelCB In .CheckBoxes
                If Not Intersect(DelCB.TopLeftCell, .Cells(Rows.Count, 1).End(xlUp).Offset(, 2)) _
                    Is Nothing Then DelCB.Delete: Exit For
              Next
            End With
            Exit For
          End If
        End If
      Next
    Next
  End With
End Sub
    • good
    • 0
この回答へのお礼

やってみます

不明な点が多くすみませんでした。
教えて頂いたコードを参考にさせて頂きます。

お礼日時:2020/08/28 16:54

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング