最終行から順番に下へ同列で入力するＶＢＡを教えて下さい。

質問

ＥＸＣＥＬのＶＢＡで教えて下さい。
セルＡ１に東京、Ａ２に名古屋、Ａ３に大阪と入力されています。
マクロのボタンにＶＢＡの実行を割当て、ボタンを押す度にＡ１の東京がＣ５に、Ａ２の名古屋がＤ５に、
Ａ３の大阪がＥ５に入力され、更にＡ２又はＡ３のセルが空白でも必ず一行ずつ同じ行に入力されるにはどうしたら良いでしょうか？

例：入力の流れ
　Ａ　　　　Ｂ　　　　Ｃ　　　　Ｄ　　　　Ｅ　　　　Ｆ　　　Ｇ・・・・・・
１東京
２名古屋
３大阪
４
５　　　　　　　　　　東京　　名古屋　大阪
６　　　　　　　　　　東京　　名古屋　大阪
７
８
・
・
・
　　　　　　　　　　　↓　　　　↓　　　　↓

　Ａ　　　　Ｂ　　　　Ｃ　　　　Ｄ　　　　Ｅ　　　　Ｆ　　　Ｇ・・・・・・
１東京
２
３大阪
４
５　　　　　　　　　　東京　　名古屋　大阪
６　　　　　　　　　　東京　　名古屋　大阪
７　　　　　　　　　　東京　　　　　　　　大阪
８
９
・
・
　　　　　　　　　　　↓　　　　↓　　　　↓

　Ａ　　　　Ｂ　　　　Ｃ　　　　Ｄ　　　　Ｅ　　　　Ｆ　　　Ｇ・・・・・・
１東京
２名古屋
３
４
５　　　　　　　　　　東京　　名古屋　大阪
６　　　　　　　　　　東京　　名古屋　大阪
７　　　　　　　　　　東京　　　　　　　　大阪
８　　　　　　　　　　東京　　名古屋
９
・
・　　　　　　　　　※ポイント
・　　　　　　　　　　セルＤ７を飛ばしてＤ８に入力される。
　　　　　　　　　　　必ず一行ずつ同じ行に入力する。
　　　　　　　　　　　ＥＸＣＥＬを再起動しても入力セルの下から
　　　　　　　　　　　続いて入力される。

回答No.3

hallo-2007 · ベストアンサー

わかり安いコードで

Sub ボタン1_Click()
Myrow = Range("C65536").End(xlUp).Row + 1
Cells(Myrow, 3).Value = Range("A1").Value
Cells(Myrow, 4).Value = Range("A2").Value
Cells(Myrow, 5).Value = Range("A3").Value
End Sub
これだけでは、ダメでしょうか。
A1の値は必ず必要（空白なし）A2,A3は空白でもOKです。

お礼

本当に解りやすいコードで助かります。ポイントは、入力元となるセルを自由に選択できることが大変便利です。実際に使用するシートでは、入力元となるセルが２０セルほどバラバラに点在しています。大変勉強になりありがとうございました。早速使用させていただきます。

回答No.4

imogasi

ロジック的に少しややこしかった。しかしコード数は少なく出来たと思う。
Sheet1にコマンドボタンを１つ貼り付ける。
そのシートの「ボタンのクリックイベント」に
ーー
Private Sub CommandButton1_Click()
d1 = Range("A65536").End(xlUp).Row 'A列最下行の取得
md2 = 5 'C5から開始のため
For k = 3 To 20 'B-T列内で最下行の取得
d2 = Cells(65536, k).End(xlUp).Row '各列での最下行
If d2 > md2 Then md2 = d2 '最大行の入れ換え
Next k
'--縦方向のものを横方向に並べ替え
For i = 1 To d1
Cells(md2 + 1, 3 + i - 1) = Cells(i, "A")
Next i
End Sub
T列は一例なので、A列の最大入力許容行数＋２までの列を見繕うこと。

お礼

ユーザーフォームに貼りつけました。たくさんの列に貼り付けする場合に、簡単に範囲を指定できることが大変便利です。大変勉強になりありがとうございました。早速使用させていただきます。

回答No.2

mitarashi

SpecialCells(xlCellTypeLastCell)は思った様な動作をしない事があるので、別の方法を取ってみましたが、#1さんと考え方は同じですね。
Sub test()
Dim lastRow As Long, i As Long
Dim targetRange As Range

With ActiveSheet
lastRow = Application.WorksheetFunction.Max(Range("c" & .Rows.Count).End(xlUp).Row, Range("d" & .Rows.Count).End(xlUp).Row, Range("e" & .Rows.Count).End(xlUp).Row)
End With
If lastRow = 1 Then lastRow = 4
Set targetRange = Range("c" & (lastRow + 1))
For i = 1 To 3
targetRange.Offset(0, i - 1).Value = Range("a" & i).Value
Next i
End Sub

お礼

入力範囲と入力開始行を指定できることは、大変便利です。大変勉強になりありがとうございました。早速使用させていただきます。

回答No.1

Daiki_PaPa

求めている物ではないかもしれませんが、参考にしてください。

---------------------------------------------------------------------
Sub Kakikomi()
Dim MaxCnt As Long, MaxRow As Long, C As Integer
　'A列の最下行を取得
　MaxCnt = Range("A65536").End(xlUp).Row
　'書き込みされたデータの最下行を取得
　MaxRow = 4
　For C = 3 To 5
　　If MaxRow < Cells(65536, C).End(xlUp).Row Then MaxRow = Cells(65536, C).End(xlUp).Row
　Next C
　MaxRow = IIf(MaxRow = 4, 5, MaxRow + 1)
　'書込
　For C = 1 To MaxCnt
　　Cells(MaxRow, C + 2).Value = Cells(C, 1).Value
　Next C
End Sub
---------------------------------------------------------------------

お礼

Ａ列に大量のデータがあるシートから抽出して、定期的に貼りつける場合にとても便利です。大変勉強になりありがとうございました。早速使用させていただきます。