「コピー領域と貼り付け領域のサイズが違う」というエラーの解消

投稿者 : ななな     投稿日時 : 2024/06/12(Wed) 11:32:39     OS : Windows 10     EXCEL : Excel 2021

---

下で記載するVBAを実行したのですが、

---
実行時エラー 1004
コピー領域と貼り付け領域のサイズが違うため、これをここに貼り付けることができません。
貼り付け領域内のいずれか1つのセルを選ぶか、または同じサイズの領域を選び、もう一度貼り付けてください。
---

というエラーメッセージが表示されて処理が止まってしまいます。

デバッグして確認をすると、転記2の「ws1.Cells(i, columnName).PasteSpecial Paste:=xlPasteValues」が黄色くなって表示されます。
原因は何が考えられるでしょうか？

（処理の概要としては、エクセルBからエクセルAのシートAに転記、その後エクセルAのシートCに転記、というものです）


---

' モジュールレベルの変数を宣言
Public monthName As String

Sub 転記1()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim i As Long, j As Long, lastRow As Long
    Dim copyRange As Range
    Dim columnName As Long ' 列名をLong型として宣言
    Dim foundCell As Range
    
    ' エクセルAとエクセルBを設定
    Set ws1 = ThisWorkbook.Sheets("シートA") 'エクセルA
    Set ws2 = Workbooks("エクセルB.xlsx").Sheets("シートB") ' エクセルB

    ' ユーザーから「〇月」の形式で入力を受け取る
    monthName = InputBox("確認する月名を入力してください（例：1月）")

    ' 「シートA」シートの2行目からその月名が入力されているセルを探し、そのセルの列を対象列にセットする
    Set foundCell = ws1.Rows(2).Find(monthName)
    If Not foundCell Is Nothing Then
        columnName = foundCell.Column
    Else
        MsgBox monthName & " は見つかりませんでした。"
        Exit Sub
    End If

    ' 指定された列の最終行を取得
    lastRow = ws1.Cells(ws1.Rows.Count, columnName).End(xlUp).Row

    j = 4 ' 初期のコピー範囲はD列

    ' 指定された列を4行目から順に確認
    i = 4
    While i <= lastRow
        ' セルの値が数値かどうか確認し、セルに計算式が入っていないことも確認
        If IsNumeric(ws1.Cells(i, columnName).Value2) And Not ws1.Cells(i, columnName).HasFormula Then
            ' 数値が見つかった場合、エクセルBからデータをコピー
            Set copyRange = ws2.Range(ws2.Cells(9, j), ws2.Cells(29, j))
            copyRange.Copy
            ws1.Cells(i, columnName).PasteSpecial Paste:=xlPasteValues

            ' 次のコピー範囲を3列右に移動
            j = j + 3

            ' 次に確認を開始する行を更新
            i = i + 21
        Else
            ' 数値が見つからなかった場合、次の行に移動
            i = i + 1
        End If

        ' 201行目に来たら、223行目に飛ぶ。それと同時に、j+15してコピー範囲を15列右に移動
        If i = 201 Then
            i = 223
            j = j + 15
        End If
    Wend

    Application.CutCopyMode = False
End Sub

Sub 転記2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim i As Long, j As Long, lastRow As Long
    Dim copyRange As Range
    Dim columnName As Long ' 列名をLong型として宣言
    Dim foundCell As Range
    Dim copyCount As Long ' コピー＆貼り付けの回数をカウント

    ' エクセルAとエクセルBを設定
    Set ws1 = ThisWorkbook.Sheets("シートC") ' "シートC"タブに移動
    Set ws2 = Workbooks("エクセルB.xlsx").Sheets("シートB") ' エクセルB

    ' 「シートC」シートの2行目からその月名が入力されているセルを探し、そのセルの列を対象列にセットする
    Set foundCell = ws1.Rows(2).Find(monthName)
    If Not foundCell Is Nothing Then
        columnName = foundCell.Column
    Else
        MsgBox monthName & " は見つかりませんでした。"
        Exit Sub
    End If

    ' 指定された列の最終行を取得
    lastRow = ws1.Cells(ws1.Rows.Count, columnName).End(xlUp).Row

    j = 28 ' 初期のコピー範囲は28列目からスタート
    copyCount = 0 ' コピー＆貼り付けの回数を初期化

    ' 指定された列を4行目から順に確認
    i = 4
    While i <= lastRow - 21 And copyCount < 5 ' lastRow - 21までループを実行し、コピー＆貼り付けの回数が5回未満である限り続ける
        ' セルの値が数値かどうか確認し、セルに計算式が入っていないことも確認
        If IsNumeric(ws1.Cells(i, columnName).Value2) And Not ws1.Cells(i, columnName).HasFormula Then
            ' 数値が見つかった場合、エクセルBからデータをコピー
            ' ただし、コピー元の列が非表示になっている場合は飛ばす
            While ws2.Columns(j).Hidden
                j = j + 3
            Wend
            Set copyRange = ws2.Range(ws2.Cells(9, j), ws2.Cells(29, j))
            copyRange.Copy
            ws1.Cells(i, columnName).PasteSpecial Paste:=xlPasteValues

            ' 次のコピー範囲を3列右に移動
            j = j + 3

            ' 次に確認を開始する行を更新
            i = i + 21

            ' コピー＆貼り付けの回数をインクリメント
            copyCount = copyCount + 1
        Else
            ' 数値が見つからなかった場合、次の行に移動
            i = i + 1
        End If
    Wend

    Application.CutCopyMode = False
End Sub

投稿者 : 多分     投稿日時 : 2024/06/12(Wed) 12:29:29

---

セルの結合はやめましょう

投稿者 : ななな     投稿日時 : 2024/06/12(Wed) 13:22:16

---

■[返信 1] 多分さん（2024-06-12 12:29:29）の記事
＞ セルの結合はやめましょう

ありがとうございます、対象のシートには結合されたセルはなんですよね……それ以外に何か原因はあるのでしょうか……？

投稿者 : さんこう     投稿日時 : 2024/06/12(Wed) 14:53:21

---

＞というエラーメッセージが表示されて処理が止まってしまいます。

エラーで止まったときの、

・コピー元がどこか
・コピー先がどこか

を確認して、手動でコピーを試してみてはいかがでしょうか。

投稿者 : ななな     投稿日時 : 2024/06/12(Wed) 16:37:04

---

皆様、回答いただきありがとうございます！
原因は不明ですが、なぜか時間をおいて同じコードで実行したら問題なく動きました……。
ネットで調べていたところ、同じような事例の方で、時間が経ったらなぜか動くようになったという方が他にもいたので、似たような症状だったのかもしれません……。
とりあえず治りましたので質問を閉じます、ありがとうございました。