エラー1004の対処法

投稿者 : 困り眉     投稿日時 : 2023/04/26(Wed) 11:28:54     OS : Windows 11     EXCEL : Excel 2019

---

有識者の皆様の知恵をお借りしたく投稿いたしました。
下記VBAで出力を行うと、http://club-vba.tokyo/vba-delete-error/#toc3 のサイトに書かれているエラーが出てしまいます。
このエラーを解消するには、どこを修正すればよいでしょうか？
よろしくお願いいたします。

Sub outputFile()

On Error GoTo ERR_HANDLER
    Dim mywb        As Workbook
    Dim targetwb        As Workbook
    Dim sheetcnt    As Long
    Dim targetsheet As Worksheet
    Dim sheetcheck  As Boolean
    Dim intRow      As Long
    Dim i           As Variant
    Dim FSO     As Variant
    Dim c As Variant
    Dim fPath As String
    Dim strOutputFileName As String
    Dim ws
    Dim strDay
    
    If Range(dateRange) = "" Then
        MsgBox "日付が設定されていません。", vbExclamation
        Exit Sub
        
    End If
    
    GP_StopSCUPD
    fPath = ThisWorkbook.Path & "\"
    strDay = Range(dateRange)
    
    For i = 1 To 7

    
        strOutputFileName = fPath & "配置表_" & Format(strDay, "yymmdd") & ".xlsx"
       
        
        Set mywb = ActiveWorkbook
    
        Set targetwb = Workbooks.Add
        

         ThisWorkbook.Sheets(Array("配置表1週間分", "隊員名簿")).Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
         
        targetwb.Sheets(ActiveSheet.Name).Name = "配置表"
        Application.DisplayAlerts = False
        For Each ws In targetwb.Sheets
            If ws.Name = "Sheet1" Then
                ws.Delete
                Exit For
            End If
        Next ws
        
        Set targetsheet = targetwb.Sheets("配置表")
        
        For Each c In targetsheet.Shapes
            c.Delete
        Next
        
        With targetsheet
            ActiveWindow.ScrollColumn = 1
            ActiveWindow.ScrollRow = 1
            .Columns("A:A").Delete Shift:=xlToLeft
        If i = 1 Then
            .Rows("19:120").Delete Shift:=xlUp
        ElseIf i = 2 Then
            .Rows("36:120").Delete Shift:=xlUp
            .Rows("2:18").Delete Shift:=xlUp
        ElseIf i = 3 Then
            .Rows("53:120").Delete Shift:=xlUp
            .Rows("2:35").Delete Shift:=xlUp
        ElseIf i = 4 Then
            .Rows("70:120").Delete Shift:=xlUp
            .Rows("2:52").Delete Shift:=xlUp
        ElseIf i = 5 Then
            .Rows("87:120").Delete Shift:=xlUp
            .Rows("2:69").Delete Shift:=xlUp
        ElseIf i = 6 Then
            .Rows("104:120").Delete Shift:=xlUp
            .Rows("2:86").Delete Shift:=xlUp
        ElseIf i = 7 Then
            .Rows("2:103").Delete Shift:=xlUp
        
        End If
        
            .Range(Cells(2, 1), Cells(18, 1)).Copy
            .Range("A19").PasteSpecial
            
            .Range("L2:U18").Cut
            .Range("B19").Select
            ActiveSheet.Paste
    
            .Range("A35").Borders(xlEdgeBottom).Weight = xlMedium
            
            .Range("B19:B35").Borders(xlEdgeLeft).Weight = xlMedium

            .Columns("A:A").EntireColumn.AutoFit

            .Range("R1") = ""
            .Range("J1") = strDay
            .Range("J1").NumberFormatLocal = "yyyy年mm月dd日(aaa)"
            
            .Range("J1:K1").Merge
            .Range("A1").Select
           
        End With
        
        Application.DisplayAlerts = True
        
          '印刷設定
        Application.ActivePrinter = "Microsoft Print to PDF on Ne01:"
        Application.PrintCommunication = False
        ActiveSheet.PageSetup.PrintArea = "A1:K35"
         With Worksheets("配置表").PageSetup
             .PaperSize = xlPaperB4
             .Orientation = xlLandscape
             .CenterHorizontally = True
             .Zoom = False
             .FitToPagesWide = 1
         End With
        Application.PrintCommunication = True
       
         
       
        
        Set FSO = CreateObject("Scripting.FileSystemObject")
        If FSO.FileExists(strOutputFileName) = True Then
            FSO.DeleteFile strOutputFileName
        End If

        ActiveWorkbook.SaveAs strOutputFileName
        ActiveWorkbook.Close
        strDay = DateAdd("d", 1, strDay)
    Next i
    
    MsgBox "ファイルの保存が完了しました。", vbInformation

QUIT_OPER:
    GP_StartSCUPD
    
    Exit Sub
    

ERR_HANDLER:
    MsgBox Err.Number & ")" & Err.Description, vbExclamation
    GoTo QUIT_OPER:
End Sub

投稿者 : さんこう     投稿日時 : 2023/04/26(Wed) 12:17:23

---

これ↓があると、エラーの原因が見えなくなってしまいます。

On Error GoTo ERR_HANDLER

エラーが解消されるまでは、コメントアウトしておくといいでしょう。

投稿者 : 困り眉     投稿日時 : 2023/04/26(Wed) 12:40:11

---

■[返信 1] さんこうさん（2023-04-26 12:17:23）の記事
＞ これ↓があると、エラーの原因が見えなくなってしまいます。
＞
＞ On Error GoTo ERR_HANDLER
＞
＞ エラーが解消されるまでは、コメントアウトしておくといいでしょう。
＞
＞

さんこうさん、返信ありがとうございます！
コメントアウトして出力してみると、

実行時エラー 1004エラー
Rangeクラスのdeleteメソッドが失敗しました。

と表示されました。調べながら修正を試みてますが、
Excelデータの軽量化のため、Accessのデータベースを
参照するようになってからこの調子です。
またアドバイス等ございましたら、何卒宜しくお願い致します。

投稿者 : 困り眉     投稿日時 : 2023/04/26(Wed) 15:41:32

---

■[返信 2] 困り眉さん（2023-04-26 12:40:11）の記事
＞ ■[返信 1] さんこうさん（2023-04-26 12:17:23）の記事
＞ ＞ これ↓があると、エラーの原因が見えなくなってしまいます。
＞ ＞
＞ ＞ On Error GoTo ERR_HANDLER
＞ ＞
＞ ＞ エラーが解消されるまでは、コメントアウトしておくといいでしょう。
＞ ＞

エラーの箇所が見つかりました！
64行目 .Rows("2:18").Delete Shift:=xlUp でエラーが返ってきてます。
今まではこの分で通っていたのですが、何が原因でしょう？
どなたか、ご指摘いただけますでしょうか？

投稿者 : さんこう     投稿日時 : 2023/04/26(Wed) 17:49:25

---

＞64行目 .Rows("2:18").Delete Shift:=xlUp でエラーが返ってきてます。

とくにおかしなところは見当たりませんが。

当該シートの2～18行を、手動で削除するとどうなりますか？

投稿者 : 困り眉     投稿日時 : 2023/04/27(Thu) 11:38:24

---

■[返信 4] さんこうさん（2023-04-26 17:49:25）の記事
＞ ＞64行目 .Rows("2:18").Delete Shift:=xlUp でエラーが返ってきてます。
＞
＞ とくにおかしなところは見当たりませんが。
＞
＞ 当該シートの2～18行を、手動で削除するとどうなりますか？
＞

削除して実行すると、８２行目のところでエラーが返ってきますね…。
セルの保護など外してみても同じ結果でした…

投稿者 : さんこう     投稿日時 : 2023/04/27(Thu) 11:52:01

---

＞＞ 当該シートの2～18行を、手動で削除するとどうなりますか？

＞削除して実行すると、８２行目のところでエラーが返ってきますね…。


「手動で削除」は問題なくできたのですね？

「８２行目」とは、「.Range(Cells(2, 1), Cells(18, 1)).Copy」ですか？

投稿者 : 困り眉     投稿日時 : 2023/04/27(Thu) 13:11:48

---

■[返信 6] さんこうさん（2023-04-27 11:52:01）の記事
＞ ＞＞ 当該シートの2～18行を、手動で削除するとどうなりますか？
＞
＞ ＞削除して実行すると、８２行目のところでエラーが返ってきますね…。
＞
＞
＞ 「手動で削除」は問題なくできたのですね？
＞
＞ 「８２行目」とは、「.Range(Cells(2, 1), Cells(18, 1)).Copy」ですか？
＞

すみません確認不足でした！
デバッグで上から一個ずつ実行し、躓いたところで手動で削除することはできました。
＞ 「８２行目」とは、「.Range(Cells(2, 1), Cells(18, 1)).Copy」ですか？
そうです。８２行目であってます。

投稿者 : 困り眉     投稿日時 : 2023/04/27(Thu) 13:18:38

---

申し訳ありません。今もう一度「手動で削除」をしたところ、
2～18は削除できませんでした。

投稿者 : さんこう     投稿日時 : 2023/04/27(Thu) 13:27:01

---

＞「.Range(Cells(2, 1), Cells(18, 1)).Copy」

このエラーであれば、「.Range」（targetsheet.Range）に、
アクティブシートの「Cells」を使っているからかと思います。
（とはいうものの、すんなり動作していれば「targetsheet」はアクティブシートみたいですね）

参考になれば。

＜range cells 組み合わせ エラー＞
https://www.google.com/search?q=range+cells+%E7%B5%84%E3%81%BF%E5%90%88%E3%82%8F%E3%81%9B+%E3%82%A8%E3%83%A9%E3%83%BC

投稿者 : 困り眉     投稿日時 : 2023/04/27(Thu) 14:13:16

---

■[返信 9] さんこうさん（2023-04-27 13:27:01）の記事
＞ ＞「.Range(Cells(2, 1), Cells(18, 1)).Copy」
＞
＞ このエラーであれば、「.Range」（targetsheet.Range）に、
＞ アクティブシートの「Cells」を使っているからかと思います。
＞ （とはいうものの、すんなり動作していれば「targetsheet」はアクティブシートみたいですね）
＞
＞ 参考になれば。
＞
＞ ＜range cells 組み合わせ エラー＞
＞ https://www.google.com/search?q=range+cells+%E7%B5%84%E3%81%BF%E5%90%88%E3%82%8F%E3%81%9B+%E3%82%A8%E3%83%A9%E3%83%BC
＞
＞

ありがとうございます！さんこうさんのおかげで.Rengeの部分は無事に修正できました！
助かりました！

投稿者 : さんこう     投稿日時 : 2023/04/27(Thu) 14:20:29

---

＞ もう一度「手動で削除」をしたところ、2～18は削除できませんでした。

そうであれば、VBAの問題ではないです。
（メッセージとか出ないのですか？）

シートでの何らかの設定が影響しているのでしょう。

最悪、シートの作り直しが必要になるかもしれません。

投稿者 : 困り眉     投稿日時 : 2023/04/27(Thu) 14:46:31

---

■[返信 11] さんこうさん（2023-04-27 14:20:29）の記事
＞ ＞ もう一度「手動で削除」をしたところ、2～18は削除できませんでした。
＞
＞ そうであれば、VBAの問題ではないです。
＞ （メッセージとか出ないのですか？）
＞
＞ シートでの何らかの設定が影響しているのでしょう。
＞
＞ 最悪、シートの作り直しが必要になるかもしれません。

ありがとうございます。原因が分かりました。
当該範囲の中にテーブルが含まれていたため削除できないとはじかれてました。
非常に勉強になりました！本当にありがとうございます！