配列に格納したデータを指定行以下に転記する方法

質問

excel2000を使っています。
以下のコードだと最終行にデータが転記されます。これを４行目に確定して、転記したいのです。常に４行目つまりＡ列４行目以下に上書きしたいのです。
その場合コードをどのように変更すべきでしょうか？

Sub 配列()
With ActiveSheet
' 配列に格納 ---------------------------
Dim i As Integer
Dim LastRow As Long
Dim SaleAry As Variant
' 配列に格納 ---------------------------
SaleAry = Array(.Range("t4"), .Range("e5"), .Range("ｇ5"), .Range("o5"))
End With
' 転記 ---------------------------
With Worksheets("daityou")
LastRow = .Range("A65536").End(xlUp).Row
For i = 0 To UBound(SaleAry)
.Cells(LastRow + 1, i + 1).Value = SaleAry(i) '
Next i
End With
Set SaleAry = Nothing
End Sub

回答No.5

zap35 · ベストアンサー

回答してくださった方の質問に満足に回答されていらっしゃいませんね。きちんと補足回答されるほうが解決が早くなると思いますよ。

１）「常に４行目つまりＡ列４行目以下に上書きしたい」は「常に４行目に書き込む」という意味でしょうか？
もしその通りなら質問文のマクロの下から５行目を以下にするだけで良いかもしれません。
.Cells(4, i + 1).Value = SaleAry(i)

２）「ご回答２件とも実行しましたが出来ませんでした」とは具体的にどのような結果になったのですか？　それでは次の回答が書けませんよ。

３）「上の続きで次のコードを実行したいのです」？？
　補足に書かれているマクロから質問文のマクロをコールしているように見えます。少し表現が違いませんか？　

それはさておいて、結局やりたいことは「"Ａ",　"Ｂ",　"Ｃ",　"Ｄ",　"Ｅ",　"Ｆ",　"Ｇ",　"Ｈ",　"Ｉ",　"Ｊ"の１０枚の各シートで、T4→A4、E5→B4、G5→C4、O5→D4の転記を行う」ことでよろしいでしょうか？

もしそうであれば以下のマクロ１つだけで実現できると思います。（２つに分けてももちろん問題はないですが…）
４つのセルしかないなら配列を使うまでもないでしょう。

Sub 転記作業()
Dim List
Dim SheetName As String
Dim idx As Integer
　On Error Resume Next
　List = Array("Ａ", "Ｂ", "Ｃ", "Ｄ", "Ｅ", "Ｆ", "Ｇ", "Ｈ", "Ｉ", "Ｊ")
　For idx = 0 To UBound(List)
　　With Worksheets(List(idx))
　　　.Range("A4").Value = .Range("T4").Value
　　　.Range("B4").Value = .Range("E5").Value
　　　.Range("C4").Value = .Range("G5").Value
　　　.Range("D4").Value = .Range("O5").Value
　　End With
　Next idx
　Worksheets("daityou").Activate
End Sub

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

またシート名は全角文字、半角文字を間違えると正しい結果にならないのでお気をつけください。

お礼

仰せのとおりで深く反省しています。ＶＢＡは奥がふかいこと身にしみています。ご回答者の方々の気分を害されたことお詫び申し上げます。非常に簡略化されたスクリブとでご指導の方法でつくりなおしてみます。
本当にありがとうございました。

回答No.4

pauNed

ついでに補足です。クリアせず上書きなら
Sub　転記作業2()
　　　　Dim　n　As　Long
　　　　Dim　list,　SheetName

　　　　Application.ScreenUpdating　=　False
　　　　list　=　Array("Ａ",　"Ｂ",　"Ｃ",　"Ｄ",　"Ｅ",　"Ｆ",　"Ｇ",　"Ｈ",　"Ｉ",　"Ｊ")
　　　　n　=　4
　　　　For　Each　SheetName　In　list
　　　　　　　　Call　sample2(Sheets(SheetName),　n)
　　　　　　　　n　=　n　+　1
　　　　Next
　　　　Worksheets("daityou").Activate
　　　　Application.ScreenUpdating　=　True
End　Sub

Sub　sample2(sh　As　Worksheet,　i　As　Long)
　　　　Dim　SaleAry　As　Variant

　　　　With　sh
　　　　　　　　SaleAry　=　Array(.Range("t4").Value,　.Range("e5").Value　_
　　　　　　　　　　　　　　　　　　　　　　　　　　　,　.Range("g5").Value,　.Range("o5").Value)
　　　　End　With
　　　　Worksheets("daityou").Cells(i,　1).Resize(,　4).Value　=　SaleAry
　　　　Erase　SaleAry
End　Sub
...な感じ。

お礼

詳しくご丁寧なご回答に感謝申し上げます。
今実行しましたら出来ました。ありがとうございました。

回答No.3

pauNed

#2補足へのレスです。

......
>手作業でもマクロでも良いのでA4:D4以下をクリアして、
と書いたように、

Sub　転記作業()
　　　　Application.ScreenUpdating　=　False
　　　　Dim　list,　SheetName
　　　　list　=　Array("Ａ",　"Ｂ",　"Ｃ",　"Ｄ",　"Ｅ",　"Ｆ",　"Ｇ",　"Ｈ",　"Ｉ",　"Ｊ")　'
　　　　With　Worksheets("daityou")　'■
　　　　　　　　　.Range("D4",　.Range("A65536").End(xlUp)).ClearContents　'■
　　　　End　With　'■
　　　　For　Each　SheetName　In　list
　　　　　　　　Sheets(SheetName).Activate
　　　　　　　　Call　配列
　　　　Next
　　　　Worksheets("daityou").Activate
End　Sub

...として、元のSub 配列()を使うわけにはいかないのですか？

回答No.2

pauNed

こんにちは。
４行目『固定』なら

Sub sample()
　　Dim SaleAry As Variant

　　With ActiveSheet
　　　　' 配列に格納 ---------------------------
　　　　SaleAry = Array(.Range("t4").Value, .Range("e5").Value, .Range("g5").Value, .Range("o5").Value)
　　End With
　　' 転記 ---------------------------
　　Worksheets("daityou").Cells(4, 1).Resize(, 4).Value = SaleAry
　　Erase SaleAry
End Sub

配列に格納する時に、『.Range("t4")』とすると、Range型で格納され、SaleAryはObject型になります。
『.Range("t4").Value』などとすると値だけの格納になります。

Ａ列４行目『以下』という意味が、このマクロを実行するごとに４行目→５行目...と上書きさせたい
という意味なら、ちょっとややこしいと思います。
その場合は、４行目に上書きしたい直前に、手作業でもマクロでも良いのでA4:D4以下をクリアして、
元のSub 配列()を使えば良いのではないかと思います。

補足

ご回答２件とも実行しましたが出来ませんでした。上の続きで次のコードを実行したいのです。説明不足ですいません。
Sub 転記作業()
Application.ScreenUpdating = False
Dim list, SheetName
list = Array("Ａ", "Ｂ", "Ｃ", "Ｄ", "Ｅ", "Ｆ", "Ｇ", "Ｈ", "Ｉ", "Ｊ") '
For Each SheetName In list
Sheets(SheetName).Activate
Call 配列
Next
Worksheets("daityou").Activate
End Sub

回答No.1

Wendy02

こんにちは。
特に、配列に入れる必要性はないようですね。
「常に4行目以下に上書き」ということは分かりませんが、常に4行目に上書きなら、このようになります。なお、元のコードは、Set SaleAry = Nothing　は、ちょっとへんです。Erase のはずです。

Sub 配列R()
　　With ActiveSheet
　　　　' 配列に格納 ---------------------------
　　　　Dim i As Integer
　　　　Dim LastRow As Long
　　　　Dim SaleRng As Range
　　　　' 配列に格納 ---------------------------
　　　　Set SaleRng = .Range("t4,e5, ｇ5, o5")
　　End With
　　' 転記 ---------------------------
　　With Worksheets("daityou")
　 'A列4行目に上書き（
　　　　LastRow = 4
　　　　For i = 1 To SaleRng.Areas.Count
　　　　　　.Cells(LastRow, i).Value = SaleRng.Areas(i)
　　　　Next i
　　End With
　　Set SaleRng = Nothing
End Sub