Excel VBA 貼り付け場所の指定

Question

お世話になっております。
こちらで運用していたのですが、今開いているブックに新しくシートを作らず、もともと作成しておいた集計というシートの(C4)から貼り付けたいのですが、どうすればよろしいでしょうか？
集計というブックにはA1:B600までは文字が入っています
よろしくお願いいたします。

追記
消してコードを入れてみましたが動作せず。
新しく別シートを作って
=IF(ISREF(INDIRECT("集計!c4")),INDIRECT("集計!c5"),"")
をすべてのセルにそれぞれ対応させるように入力してみたりしてみましたが、動作が遅くなり断念。
という段階です。

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("AI1:AK600").Copy
MergeSheet.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial _
Paste:=xlPasteValues
Application.DisplayAlerts = False
Next
CurrentBook.Close False
n = n + 1
End If
Filename = Dir
Loop

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

Comments

[1T2R3M4]

ご自身で調べたこと、試したことはないのでしょうか。
作った人に聞くのが一番ですが。

[minakosun]

消してコードを入れてみましたが動作せず。
新しく別シートを作って
=IF(ISREF(INDIRECT("集計!c4")),INDIRECT("集計!c5"),"")
をすべてのセルにそれぞれ対応させるように入力してみたりしてみましたが、動作が遅くなり断念。
ということまではやってみました。

Answer 1

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("集計")  '--もともと作成しておいたシート--
    
    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("AI1:AK600").Copy
                MergeSheet.Range("C4").Offset(, n * 3).PasteSpecial Paste:=xlPasteValues
                                 '最初はC4、次から順に右へ
                Application.DisplayAlerts = False
            Next
            CurrentBook.Close False
            n = n + 1
        End If
        Filename = Dir
    Loop
    
    Application.ScreenUpdating = True
    MsgBox n & "件のブックを処理しました。"
End Sub

Comments

[minakosun]

どこを変更していて、何が動作するのかもわかりやすくて助かりました！