エクセル：下にコピーをマクロで（条件付）

質問

お世話になります。
エクセルでの入力で、「下にコピー」を多用する仕事があります。
以下の例をマクロでやりたいです。

例
まずＣ列、Ｄ列、Ｅ列のうちデータが入っている行がもっとも大きい列を判断します。
Ｃ１０、Ｄ１２、Ｅ１３が各列のデータが入っている最大行の場合、Ｅ１３の１３行目が最大になります。このようにＥ列が最大になる場合、Ｃ列はＣ１０の値を１３行目まで下にコピー、Ｄ列はＤ１２の値を１３行目まで下にコピーします。(Ctrl+D)
（ここでいう１３行目までというのは最大値Ｅ１３の１３を意味します。）
また、Ｃ１２、Ｄ１５、Ｅ１１が各列のデータが入っている最大行の場合、Ｄ１５の１５行目が最大になります。Ｄ列が最大になる場合は、Ｃ列のＣ１２の値を１５行目まで下にコピーします。（Ｅ列に対してはなにもしない）
さらに、Ｃ１３、Ｄ１０、Ｅ１１が各列のデータが入っている最大行の場合、Ｃ１３の１３行目が最大になります。Ｃ列が最大になる場合はなにもしない。
Ｃ列、Ｄ列、Ｅ列のうちデータが入っている行がもっとも大きい列が判断できない場合（Ｃ１４、Ｄ１４、Ｅ１２など最大行が同じ場合）の時も何もしません。
これをマクロでやる場合、どうすればよいでしょうか？

回答No.2

zap35 · ベストアンサー

＃０１です。質問文を良く読んでいませんでした。すみません。
以下に差し替えてください。後半の２行を追加しています

Sub Macro()
Dim LastR(5), MaxR As Long
Dim MaxCOL As String
Dim idx As Integer
With ActiveSheet
For idx = 3 To 5
LastR(idx) = .Cells(65536, idx).End(xlUp).Row
Next idx
If LastR(3) > LastR(4) And LastR(3) > LastR(5) Then
MaxR = LastR(3)
MaxCOL = "C"
Else
If LastR(4) > LastR(3) And LastR(4) > LastR(5) Then
MaxR = LastR(4)
MaxCOL = "D"
Else
If LastR(5) > LastR(3) And LastR(5) > LastR(4) Then
MaxR = LastR(5)
MaxCOL = "E"
Else
MaxCOL = ""
End If
End If
End If

If MaxCOL = "" Then
Exit Sub
Else
For idx = 3 To 5
If LastR(idx) < MaxR Then
.Cells(LastR(idx), idx).Copy _
Destination:=Range(.Cells(LastR(idx), idx).Offset(1, 0), _
.Cells(MaxR, idx))
Else　'追加
Exit For　'追加
End If
Next idx
End If
End With
End Sub

お礼

ありがとうございました。
希望通りの動きをしてくれました。

回答No.1

zap35

マクロをALT＋F11でVBE画面を開き、左上のVBA Projectでシート名を右クリックし「挿入」→「標準モジュール」で表示される画面に貼り付けて下さい。マクロの実行はALT＋F8でマクロ一覧を開き、マクロ名を選択して「実行」ボタンです。

Sub Macro()
Dim LastR(5), MaxR As Long
Dim MaxCOL As String
Dim idx As Integer
With ActiveSheet
　For idx = 3 To 5
　　LastR(idx) = .Cells(65536, idx).End(xlUp).Row
　Next idx
　If LastR(3) > LastR(4) And LastR(3) > LastR(5) Then
　　MaxR = LastR(3)
　　MaxCOL = "C"
　Else
　　If LastR(4) > LastR(3) And LastR(4) > LastR(5) Then
　　　MaxR = LastR(4)
　　　MaxCOL = "D"
　　Else
　　　If LastR(5) > LastR(3) And LastR(5) > LastR(4) Then
　　　　MaxR = LastR(5)
　　　　MaxCOL = "E"
　　　Else
　　　　MaxCOL = ""
　　　End If
　　End If
　End If

　If MaxCOL = "" Then
　　Exit Sub
　Else
　　For idx = 3 To 5
　　　If LastR(idx) < MaxR Then
　　　　.Cells(LastR(idx), idx).Copy _
　　　　　Destination:=Range(.Cells(LastR(idx), idx).Offset(1, 0), _
　　　　　　.Cells(MaxR, idx))
　　　End If
　　Next idx
　End If
End With
End Sub

補足

ご回答ありがとうございます。
早速試してみました。
Ｅ列が最大値の場合では完璧に出来ました。
ただ、Ｄ列が最大の場合はＥ列は下にコピーしないという点と、Ｃ列が最大値の場合は何もしないようにしたいです。
今は、すべての場合において下にコピーされるようですので。
アドバイスお願いします。