[[20201225110230]]　『掲載したマクロ【貼り付け方法の変更】ご教示願い』（れん）　ページの最後に飛ぶ

『掲載したマクロ【貼り付け方法の変更】ご教示願います。』（れん）

下記のマクロをマクロを実行しているファイルの「シート5」に実行したいです。
また、張り付ける際に値で実行したいです。。

Option Explicit

Sub book_sum_1sheet()

    Dim sFile As String
    Dim sWB As Workbook, dWB As Workbook
    Dim dSheetCount As Long
    Dim i As Long
    Dim dl_Dir As String
    Dim SOURCE_DIR As String
    Dim DEST_FILE As String
    Dim flg As Long
    Dim Maxrow As Long, Maxcol As Long
    Dim lRow As Long 'データ最終行取得変数
    Dim lCol As Long 'データ最終列取得変数
    Dim lRow2 As Long 'データ最終行取得変数2

    Application.ScreenUpdating = False '更新非表示

    'ダイアログでフォルダ選択
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "保存フォルダを選択して下さい"
        If .Show = False Then Exit Sub
        dl_Dir = .SelectedItems(1)
    End With

    SOURCE_DIR = dl_Dir & "\"
    DEST_FILE = SOURCE_DIR & "全法人予算表.xlsx"

    '指定したフォルダ内にあるブックのファイル取得
    sFile = Dir(SOURCE_DIR & "*.xls*")

    'フォルダ内にブックがなければ終了
    If sFile = "" Then Exit Sub

    '集約用ブックを作成
    Set dWB = Workbooks.Add
    ActiveSheet.Name = "全法人予算表"

    flg = 0
    Do
        '全法人予算表.xlsxのチェック
        If sFile <> "全法人予算表.xlsx" Then
            Set sWB = Workbooks.Open(Filename:=SOURCE_DIR & sFile, ReadOnly:=True)

            'シート再表示
            For i = 1 To Sheets.Count
                Sheets(i).Visible = True
            Next i
            Sheets(1).Select

            sWB.Activate

            'データを1シートにまとめる
            For i = 1 To Worksheets.Count
            sWB.Activate
            With Worksheets(i)
                lRow = .Cells(Rows.Count, 1).End(xlUp).Row
                lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
                'シートのデータが2行以上の場合にコピー
                If lRow >= 2 Then
                    dWB.Activate
                    lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
                    .Activate
                    .Range(Cells(2, 1), Cells(lRow, lCol)).Copy dWB.Worksheets(1).Cells(lRow2, 1)
                    dWB.Worksheets(1).Activate
                    Maxrow = Cells(Rows.Count, 1).End(xlUp).Row
                    Worksheets(1).Range(Cells(lRow2, Maxcol + 1), Cells(Maxrow, Maxcol + 1)).Value = sWB.Name
                    Worksheets(1).Range(Cells(lRow2, Maxcol + 2), Cells(Maxrow, Maxcol + 2)).Value = .Name

                End If
            End With
            Next i
            'コピー元ファイルを閉じる
            sWB.Close SaveChanges:=False
        End If

        '次のブックのファイル名を取得
        sFile = Dir()
        flg = flg + 1
    Loop While sFile <> ""

    '集約用ブックを保存して閉じる
    dWB.SaveAs Filename:=DEST_FILE
    dWB.Close SaveChanges:=False

    ThisWorkbook.Sheets(1).Cells(2, 4) = dl_Dir

    MsgBox "完了しました" & vbCrLf & "作業フォルダにファイルが作成されました"

    Application.ScreenUpdating = True '更新表示

End Sub

＜使用 Excel：Excel2010、使用 OS：Windows10 ＞

そもそも提示したマクロは理解できてますか？
理解できていないものを改造するのは無理ですから、まずはステップ実行するなどして動きを確認し、分からない命令があればネット検索するなどして研究してみましょう。

次に
＞マクロを実行しているファイルの「シート5」
↓に注目してみましょう

 .Range(Cells(2, 1), Cells(lRow, lCol)).Copy dWB.Worksheets(1).Cells(lRow2, 1)

＞張り付ける際に値で実行
【マクロの記録】を使って、コピーしたあと、「形式を選択してはりつけ」-「値」という作業をコード化してみて、どのような命令を使っているか調べてみましょう。

（もこな２） 2020/12/25(金) 13:41

追加で。

■１
VBAの世界では基本的にシートやセルなど（オブジェクトといいます）を明示すれば、いちいちアクティブにしたり選択したりする必要はありません。

■２
「標準モジュール」で「Cells(2, 1)」のような書き方をした場合、「ActiveSheet.Cells(2, 1)」のようにアクティブシートを指定したものとして扱われます。
したがって、想定外のシートを対象にしないためにも、対象のブックやシートは明示したほうがよいとおもいます。

■３
シートの非表示を解除（再表示）していますが、アクティブにしないなら不要だと思います。

■４
↓のように最終列をもとめていますが必要ですか？

 lCol = .Cells(1, Columns.Count).End(xlToLeft).Column

データを集約するような場合、大体最大【列】は決まっているんじゃないでしょうか？
（項目数はどのファイルも一緒じゃありません？）

（もこな２） 2020/12/25(金) 13:55

コメント返信：

[ 一覧(最新更新順) ]

[[20201225110230]] 『掲載したマクロ【貼り付け方法の変更】ご教示願い』（れん） ページの最後に飛ぶ

[[20201225110230]]　『掲載したマクロ【貼り付け方法の変更】ご教示願い』（れん）　ページの最後に飛ぶ