エクセル ＶBA 改行できない

Question

一つのセルのデータを貼り付けた後に一個右の一番上のセルに貼り付けていくのを繰り返したいのですが
どうも改行がうまくいきません、お分かりになる方いらっしゃいますでしょうか？

Sub Merge()

Dim MergeBook As Workbook
Dim CurrentBook As Workbook
Dim CurrentPath As String
Dim Filename As String
Dim n As Integer

Application.ScreenUpdating = False
Set MergeBook = ThisWorkbook

Dim MergeSheet As Worksheet
Set MergeSheet = MergeBook.Worksheets.Add
MergeSheet.Name = "集計"

CurrentPath = MergeBook.Path
Filename = Dir(CurrentPath & "*.xls?")

n = 0
Do While Filename <> Empty
If Filename <> MergeBook.Name Then
Set CurrentBook = Workbooks.Open(CurrentPath & "" & Filename)
Dim ws As Worksheet
For Each ws In CurrentBook.Worksheets
ws.Range("AJ1:AK500").Copy
MergeSheet.Range("A" & MergeSheet.Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Next
CurrentBook.Close False
n = n + 1
End If
Filename = Dir
Loop

Application.ScreenUpdating = True
MsgBox n & "件のブックを処理しました。"
End Sub

(追記)現状ブックが切り替わった後に張り付けると連続して下に追加されていってしまいます。
A1に最初の貼り付けが行われた後に、（A1からB510までが埋まっている状況）ｃ1に張り付けたいのにＡ510からｂ1020までで張り付けられています。

Comments

[y_waiwai]

改行がうまくいかないというのは具体的にどうなるんでしょうか

[hatena19]

> 一つのセルのデータを貼り付けた後に一個右の一番上のセルに貼り付けていくのを繰り返したい

これも何の「一個右」なのか、「一番上」とは何を基準に一番上なのか（シートの1行目という意味？）、
具体的に説明してください。

[minakosun]

現状ブックが切り替わった後に張り付けると連続して下に追加されていってしまいます。
A1に最初の貼り付けが行われた後に、（A1からB510までが埋まっている状況）ｃ1に張り付けたいのにＡ510からｂ1020までで張り付けられています。

[hatena19]

質問は編集できますので、それを質問に追記してください。

[minakosun]

ありがとうございます。やってみます。

[hatena19]

ここのコメントまで見る人は少ないので。それに「修正依頼」の欄ですので。

Answer 1

Dim ws As Worksheet
For Each ws In CurrentBook.Worksheets
    ws.Range("AJ1:AK500").Copy
    MergeSheet.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial _
        Paste:=xlPasteValues
Next

Comments

[minakosun]

うまくできました！ありがとうございました！