gooドクター有料プランが1ヶ月間無料!

マクロ初心者で勉強中です。下記のようなマクロを書いたのですが、下に記載のところでエラーがでます。各シートの指定範囲(可変)をコピーし、集計シート貼りつけるマクロを作成しています。

どこが悪いのか教えて頂きたいです。

Sub matome公休105()
Dim i As Integer
Dim lRow As Long, lCol As Long, lRow2 As Long
Application.ScreenUpdating = False
'----全データシートの有無をチェックします
sh_check
'----列見出しをコピーします  ’見出しの範囲を指定  どこにペーストするか指定
Worksheets(2).Range("I40:J40").Copy Worksheets(1).Range("A1")
For i = 2 To Worksheets.Count
With Worksheets(i)
'シート1の最終行を求める(最終行の次の行を求める)
lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets(i).Select

 ★★★「下記のところでエラーが出ます」★★★
 Range("I42").CurrentRegion.Resize([MATCH(1,0/(I42:I50<>""))], 2).Select

'シート1の最終行の次に貼り付ける

Selection.Copy
Worksheets(1).Cells(lRow2, 1).PasteSpecial (xlPasteValues)
 End With
Next i
Worksheets(1).Activate
Range("A1").Select
Application.ScreenUpdating = True
End Sub

下記のように単体でするとうまく動作します。
Sub test()
Worksheets("原本").Activate
Range("I42").CurrentRegion.Resize([MATCH(1,0/(I42:I50<>""))], 2).Select
End Sub

gooドクター

A 回答 (3件)

遅くなりました #2です


>エラー発生した時は、そのシートの処理はとばして次のシートに移るとしたらどうなるでしょうか。
On Error Resume Nextの場合、

Selection.Copy
Worksheets(1).Cells(lRow2, 1).PasteSpecial (xlPasteValues)
が実行されてしまいますね。(誤動作)

なので結局
On Error Resume Next
Range("I42").CurrentRegion.Resize([MATCH(1,0/(I42:I50<>""))], 2).Select
If Err.Number = 0 Then
Selection.Copy
Worksheets(1).Cells(lRow2, 1).PasteSpecial (xlPasteValues)
End If
On Error GoTo 0
 End With
Next i
こんな感じになってしまいます。

#2のようにエラーでラベルに飛ばすのもエラーになっているか確かめて処理するにしても、内部的にはエラーが出力されている事には変わりませんね
なので[MATCH(1,0/(I42:I50<>""))]の代わりの処理を追加して
セルの拡張行数を取得するか、
MATCHのエラーの原因をあらかじめ調べてエラーが出る条件なら処理を
行わないようにする などが考えられます。

[MATCH(1,0/(I42:I50<>""))]の代わり テスト用
Sub a()
Dim n As Integer, cnt As Integer
'コピー範囲の最大数を取得
cnt = .Range("I42:I50").Cells.Count
'コピー範囲I42:I50に値があるか調べる
For n = 50 To 42 Step -1
If .Cells(n, "I") <> "" Then
Exit For '値が有ればforを抜ける
End If
cnt = cnt - 1 'ループごとにセル範囲を-1する
Next
MsgBox ("cnt =" & cnt & " MATCH =" & [MATCH(1,0/(I42:I50<>""))])
End Sub

この cnt を組み 不要部分を添削すると

Sub matome公休105()
Dim i As Integer
Dim lRow As Long, lCol As Long, lRow2 As Long
Dim n As Integer, cnt As Integer
Application.ScreenUpdating = False
'----全データシートの有無をチェックします
'sh_check
'----列見出しをコピーします  ’見出しの範囲を指定  どこにペーストするか指定
Worksheets(2).Range("I40:J40").Copy Worksheets(1).Range("A1")
For i = 2 To Worksheets.Count
With Worksheets(i)
'シート1の最終行を求める(最終行の次の行を求める)
lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
' Worksheets(i).Select これは Withで纏めているので無くて良いが
' Worksheets(i)に対してのレンジオブジェクトは . を加える(下記参照)
'コピー範囲の最大数を取得
cnt = .Range("I42:I50").Cells.Count
'コピー範囲()に値があるか調べる
For n = 50 To 42 Step -1
If .Cells(n, "I") <> "" Then
Exit For '値が有ればforを抜ける
End If
cnt = cnt - 1 'ループごとにセル範囲を-1する
Next
'すべて空白セルなら実行しない(セル範囲が0)
If cnt > 0 Then
'シート1の最終行の次に貼り付ける
.Range("I42").Resize(cnt, 2).Copy
Worksheets(1).Cells(lRow2, 1).PasteSpecial (xlPasteValues)
'最後のシートのコピー範囲に点々が残るので下記を追加
Application.CutCopyMode = False
End If
End With
Next i
Worksheets(1).Activate
Range("A1").Select
Application.ScreenUpdating = True
End Sub

.CurrentRegion リサイズしてしまうので要を足さないような・・?

'----全データシートの有無をチェックします
部分もあるかと思いますので先が長いのかもしれませんが、
参考になりますでしょうか。
    • good
    • 0

こんばんは、


インデックス2以降のすべてのシートで
I42:I50セル範囲すべてが空白になっているシートはありませんか?

[MATCH(1,0/(I42:I50<>""))]は該当がない場合エラーが返りますので
エラートラップを配置するか、別の方法で範囲拡張数を取得する
必要があるように思います

簡単なエラートラップ
Worksheets(i).Select

On Error GoTo MyErr
 ★★★「下記のところでエラーが出ます」★★★
Range("I42").CurrentRegion.Resize([MATCH(1,0/(I42:I50<>""))], 2).Select
'シート1の最終行の次に貼り付ける
Selection.Copy
Worksheets(1).Cells(lRow2, 1).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
MyErr:
On Error GoTo 0
End With

エラートラップが嫌な場合、例えば
If Application.CountIf(Range("I42:I50"), "<>") > 0 Then
などで値の有無をあらかじめ検証して問題部分を実行するなどが考えられますが、セルの値が ""(数式セル)になっている場合、CountIf "<>"は通ってしまいますが、MATCHはエラーになると思われますので、対象セルに数式が入っている場合は、正しく""を取得する(除外する)方法などの検討が必要かと思います。
    • good
    • 0
この回答へのお礼

ありがとうございます。少し、分かってきたような気がします。エラー発生した時は、そのシートの処理はとばして次のシートに移るとしたらどうなるでしょうか。今、調べたらResume Next でしょうか?

お礼日時:2021/05/12 03:34

Worksheets(i)のiがおかしいか、


そのWorksheets(i)内でのMATCH(1,0/(I42:I50<>""))の結果がおかしいだけではないでしょうか?

Worksheets(i)のシート内のセルのどこかに、
手動で=MATCH(1,0/(I42:I50<>""))を入力してセルに結果が表示されますか?
    • good
    • 0
この回答へのお礼

ありがとうございます。
はい、結果が数字で出ます。
この結果が3なら、表がたて3よこ2洗濯されるということですよね。

お礼日時:2021/05/12 01:40

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング