【VBA】Sheetを介してコピー貼り付けができません

前提・実現したいこと

Sheets("Sheet2").Selectの部分で下記のエラーが表示されます．
なにか解決策をご教授頂きたいです

発生している問題・エラーメッセージ

実行時エラー '1004'
アプリケーション定義またはオブジェクト定義のエラーです。

該当のソースコード

Sub 完成版データ整理()


'//ファイルを開くダイアログを開く
    selectFileName = _
        Application.GetOpenFilename( _
            FileFilter:="CSVファイル(*.xlsx),*.xlsx", _
            FilterIndex:=1, _
            Title:="読み込むファイルを選択してください。", _
            MultiSelect:=True _
            )

'//選択したファイルに対する処理
    If IsArray(selectFileName) Then

        '//全てのファイルで繰り返し処理を行う
            For Each oneFileName In selectFileName
                '//選択されたファイルを開く
                    Workbooks.Open oneFileName
                '//変数を定義
                    Dim nameCSV As String
                    Dim newCSV As Workbook
                    Dim sh1st As Worksheet
                    nameCSV = Dir(oneFileName)      'ファイル名を取得
                    Set newCSV = Workbooks(nameCSV) 'ワークブックとして定義
                    Set sh1st = newCSV.Worksheets(1) '1枚目のワークシートを定義


Dim i As Long
i = 1

Do Until i > 42

Dim j As Long
j = 4 + (i - 1) * 144
Dim k As Long
k = 147 + (i - 1) * 144


         
 '//1日ごとのデータコピー
    ActiveWorkbook.Activate
    Range(Cells(1, 1).Address & ":" & Cells(3, 57).Address & "," & Cells(j, 1).Address & ":" & Cells(k, 57).Address).Select
    Application.CutCopyMode = False
    Selection.Copy
'//新しいブックを製作
    Set wk = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
'//日付と時刻の修正
    Range("A4:A147").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormatLocal = "yyyy/m/d"
    Range("AD4:AD147").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormatLocal = "yyyy/m/d"
    Range("B4:B147").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormatLocal = "h:mm;@"
    Range("AE4:AE147").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormatLocal = "h:mm;@"
    
'//A-1 B-1の製作
    Range("B3:C147,E3:E147,G3:G147,I3:I147,K3:K147,M3:M147,O3:O147,Q3:Q147,S3:S147,U3:U147,W3:W147,Y3:Y147,AA3:AA147").Select
    Range("B3:C147,E3:E147,G3:G147,I3:I147,K3:K147,M3:M147,O3:O147,Q3:Q147,S3:S147,U3:U147,W3:W147,Y3:Y147,AA3:AA147").Activate
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("B3:B147,D3:D147,F3:F147,H3:H147,J3:J147,L3:L147,N3:N147,P3:P147,R3:R147,T3:T147,V3:V147,X3:X147,Z3:Z147,AB3:AB147").Select
    Range("B3:B147,D3:D147,F3:F147,H3:H147,J3:J147,L3:L147,N3:N147,P3:P147,R3:R147,T3:T147,V3:V147,X3:X147,Z3:Z147,AB3:AB147").Activate
    Selection.Copy
    Sheets("Sheet2").Select ←ここでエラー
    Range("O1").Select
    ActiveSheet.Paste
    Sheets("Sheet2").Name = "A-1"
    
    Sheets("Sheet1").Select
    Range("AE3:AF147,AH3:AH147,AJ3:AJ147,AL3:AL147,AN3:AN147,AP3:AP147,AR3:AR147,AT3:AT147,AV3:AV147,AX3:AX147,AZ3:AZ147,BB3:BB147,BD3:BD147").Select
    Range("AE3:AF147,AH3:AH147,AJ3:AJ147,AL3:AL147,AN3:AN147,AP3:AP147,AR3:AR147,AT3:AT147,AV3:AV147,AX3:AX147,AZ3:AZ147,BB3:BB147,BD3:BD147").Activate
    Selection.Copy
    Sheets("Sheet3").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("AE3:AE147,AG3:AG147,AI3:AI147,AK3:AK147,AM3:AM147,AO3:AO147,AQ3:AQ147,AS3:AS147,AU3:AU147,AW3:AW147,AY3:AY147,BA3:BA147,BC3:BC147,BE3:BE147").Select
    Range("AE3:AE147,AG3:AG147,AI3:AI147,AK3:AK147,AM3:AM147,AO3:AO147,AQ3:AQ147,AS3:AS147,AU3:AU147,AW3:AW147,AY3:AY147,BA3:BA147,BC3:BC147,BE3:BE147").Activate
    Selection.Copy
    Sheets("Sheet3").Select
    Range("O1").Select
    ActiveSheet.Paste
    Sheets("Sheet3").Name = "B-1"

    
    
    
    
    
    
    

'//名前を付けて保存
    With CreateObject("Scripting.FileSystemObject")
    If Not .FolderExists("C:\Work") Then .CreateFolder "C:\Work"
    End With
    Dim ws As Worksheet
    Set ws = wk.Sheets("Sheet1")
    ActiveWorkbook.SaveAs "C:\Work\" & Format(ws.Range("A4").Value, "yyyy\年mm\月dd\日") & ".xlsx"
    ActiveWorkbook.Close


        i = i + 1
        
    Loop


    
    '//ワークブックを保存する
    On Error Resume Next
    newCSV.Save
    '//ワークブックを閉じて次へ
    Application.DisplayAlerts = False
    newCSV.Close
    Application.DisplayAlerts = True
    'コピー中状態を解除
    Application.CutCopyMode = False
            Next
    Else
        MsgBox ("ファイルを選択しないで終了")
    End If



End Sub

試したこと

新規のexcellファイルに該当の部分のマクロを試すとうまくいきます．この流れの中で行うとエラーがでます．

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

行動規範の内容に同意します

回答1件

ベストアンサー

全般的に、ActiveSheetとかActiveWorkbookとかではなく
変数にセットしたオブジェクトを指定して書くと紛れがないと思います。

VBA
1'選択したファイル
2Set newCSV = Workbooks.Open(oneFileName)
3Set sh1st = newCSV.Worksheets(1)
4
5
6'転記先（新しいファイル）
7Set wk = Workbooks.Add
8
9'各シート
10Dim ws As Worksheet, ws2 As Worksheet, ws3 As Worksheet
11Set ws = wk.Worksheets(1)
12Set ws2 = wk.Worksheets(2)
13Set ws3 = wk.Worksheets(2)
14
15ws2.Name = "A-1"
16ws3.Name = "B-1"
17
18'Sheet1への転記
19sh1st.Range(sh1st.Cells(1, 1).Address & ":" & sh1st.Cells(3, 57).Address & "," & sh1st.Cells(j, 1).Address & ":" & sh1st.Cells(k, 57).Address).Copy
20ws.Range("A1").PasteSpecial xlPasteValues
21
22ws.Range("A4:A147,AD4:AD147").NumberFormatLocal = "yyyy/m/d"
23ws.Range("B4:B147,AE4:AE147").NumberFormatLocal = "h:mm;@"
24
25'Sheet2への転記
26ws.Range("B3:C147,E3:E147,G3:G147,I3:I147,K3:K147,M3:M147,O3:O147,Q3:Q147,S3:S147,U3:U147,W3:W147,Y3:Y147,AA3:AA147").Copy ws2.Range("A1")
27ws.Range("B3:B147,D3:D147,F3:F147,H3:H147,J3:J147,L3:L147,N3:N147,P3:P147,R3:R147,T3:T147,V3:V147,X3:X147,Z3:Z147,AB3:AB147").Copy ws2.Range("O1")
28
29'Sheet3への転記
30ws.Range("AE3:AF147,AH3:AH147,AJ3:AJ147,AL3:AL147,AN3:AN147,AP3:AP147,AR3:AR147,AT3:AT147,AV3:AV147,AX3:AX147,AZ3:AZ147,BB3:BB147,BD3:BD147").Copy ws3.Range("A1")
31ws.Range("AE3:AE147,AG3:AG147,AI3:AI147,AK3:AK147,AM3:AM147,AO3:AO147,AQ3:AQ147,AS3:AS147,AU3:AU147,AW3:AW147,AY3:AY147,BA3:BA147,BC3:BC147,BE3:BE147").Copy ws3.Range("O1")
32
33'ファイルの保存
34wk.SaveAs "C:\Work\" & Format(ws.Range("A4").Value, "yyyy\年mm\月dd\日") & ".xlsx"
35wk.Close
36