次のマクロコードがわかりません

質問

Q～U、W～AA、AC～AG、AK～AO、AQ～AU、AW～BA 、BE～BI
BK～BO、BQ～BU　の各列にそれぞれ下記のように（一例）データが入っています

　Q　　R　S　T　U　　　W　X　Y　Z　AA　・・・　BQ　BR　BS　BT　BU
いか　3　7　1　5　　
たこ 3　5　2　10
　　　　　　　　　　　　 えび　5　2　5　10

ここで仮にいかと同じ行にあるWで”1”と入力したら丁度同じ行の左のQ～Uの5つのデータをコピーできるようにしたいです。おなじようにえびが記入してある行のBQで” 1”と入力すればBQ～BUにえび～10までのデータがコピーされます。まとめると、各W、AC、AK、AQ、AW、BE列の任意のセルで” 1”と入力すれば左隣の5つのセルをコピーする感じです。

回答No.4

ki-aaa · ベストアンサー

こんにちわ
一箇所くらい自分で考えてほしかったのですが

Cells(1, 1).PasteSpecial Paste:=xlPasteAll
　↓
Target.PasteSpecial Paste:=xlPasteAll

お礼

大変感謝いたします。ありがとうございました(._.)

回答No.3

mt2008

こんなのでどうでしょう

Private Sub Worksheet_Change(ByVal Target As Range)
　　With Target
　　　　If (.Count = 1) * ((.Column - 23) Mod 6 = 0) * (.Column >= 23) Then
　　　　　　If .Value = 1 Then Range(Target, .Offset(0, 4)) = Range(.Offset(0, -6), .Offset(0, -2)).Value
　　　　End If
　　End With
End Sub

お礼

ご回答ありがとうございます。やりたいことと一致しています！
しかしながらQ～U、W～AA、AC～AGまでは１と入力すればコピーできたのですが、
AK～AO、AQ～AU、AW～BA 、BE～BIはコピーができませんでした。
おそらくAGまでは規則的に並んでいるのですが、AGとAKの間は列が３つあるため
そこからはずれが生じてしまいます；（わかりにくくて申し訳ありません；）

回答No.2

ki-aaa

#1です。
こちらのほうが解り易いかな

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
If Target.Count <> 1 Then Exit Sub
If Not IsNumeric(Target.Value) Then Exit Sub
If Target.Value <> 1 Then Exit Sub
If Intersect(Target, Range("W:W, AC:AC, AK:AK, AQ:AQ, AW:AW, BE:BE")) Is Nothing Then Exit Sub
i = Target.End(xlToLeft).Column - 5
Debug.Print Target.Address & " " & Target.End(xlToLeft).Column
If i < 0 Then Exit Sub
Cells(Target.Row, 1).Offset(0, i).Resize(1, 5).Copy
Application.EnableEvents = False
'ここにコピーしたものをどうするかを記述する　例↓
Cells(1, 1).PasteSpecial Paste:=xlPasteAll
Application.EnableEvents = True
End Sub

お礼

ご回答ありがとうございます。こちらのコードを使わせていただくとすべて、A1セルからE1セルに
コピーされてしまうため、利用できませんでした；

回答No.1

ki-aaa

こんにちわ
シートイベントは、理解されているものとして回答します。
そうでなかったら、補足をお願いします。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
If Target.Count <> 1 Then Exit Sub
If Not IsNumeric(Target.Value) Then Exit Sub
If Target.Value <> 1 Then Exit Sub
If Intersect(Target, Range("W:W, AC:AC, AK:AK, AQ:AQ, AW:AW, BE:BE")) Is Nothing Then Exit Sub
i = Target.End(xlToLeft).Column - 4
' Debug.Print Target.Address & " " & Target.End(xlToLeft).Column
If i < 1 Then Exit Sub
Target.Offset(0, i - Target.Column).Resize(1, 5).Copy
Application.EnableEvents = False
'ここにコピーしたものをどうするかを記述する　例↓
Cells(1, 1).PasteSpecial Paste:=xlPasteAll
Application.EnableEvents = True
End Sub

お礼

何度もご丁寧にありがとうございます；上記と同じ結果となったので申し訳ないです；