@Mervelickintopgunposted at 2022-07-31

VBAで値貼り付けができません

Q&A

Closed

解決したいこと

Excel VBAで同じブックの各シートから、値を1シートに集約したいと思っています。
ただ各シートに関数が入っているため、値貼り付けをしたいのですがこのコードだと数式が入ってしまい、.PasteSpecialを使うとエラーとなってしまいました。

発生している問題・エラー

RangeクラスのPasteSpecialプロパティを取得できません。

該当するソースコード

Sub Merge_Sheets()

Dim startRow, startCol, lastRow, lastCol As Long
Dim headers As Range
Dim ExSheet As Variant
Const FIND_STR = "_data"  ' 検索する文字列

'Set Master sheet for consolidation
Set mtr = Worksheets("Master")

Set wb = ThisWorkbook
'Get Headers
Set headers = Application.InputBox("Select the Headers", Type:=8)

'Copy Headers into master
headers.Copy mtr.Range("A1")
startRow = headers.Row + 1
startCol = headers.Column

Debug.Print startRow, startCol
'loop through all sheets
For Each ws In wb.Worksheets()
     'except the master sheet from looping
     'except sheet name with _data
     If ws.Name Like "*" & FIND_STR Then
        ws.Activate
        lastRow = Cells(Rows.Count, startCol).End(xlUp).Row
        lastCol = Cells(startRow, Columns.Count).End(xlToLeft).Column
        'get data from each worksheet and copy it into Master sheet
        
       
        Range(Cells(startRow, startCol), Cells(lastRow, lastCol)).Copy _
        mtr.Range("A" & mtr.Cells(Rows.Count, 1).End(xlUp).Row + 1)
        
        Application.CutCopyMode = False
     End If
Next ws

Worksheets("Master").Activate

End Sub

自分で試したこと

1.このコードを実施
　→「RangeクラスのPasteSpecialプロパティを取得できません。」
2.Range()箇所にSelectを追記
　→「オブジェクトが必要です」

どうぞよろしくお願いします！

1Answer

@Mervelickintopgun posted at 2022-07-31

SelectとPasteSpecialを追記した上で、元のMaster SheetをActivateしたらエラーが直りました！！お騒がせしました！！

Sub Merge_Sheets()

Dim startRow, startCol, lastRow, lastCol As Long
Dim headers As Range
Dim ExSheet As Variant
Const FIND_STR = "_data"  ' 検索する文字列

'Set Master sheet for consolidation
Set mtr = Worksheets("Master")

Set wb = ThisWorkbook
'Get Headers
Set headers = Application.InputBox("Select the Headers", Type:=8)

'Copy Headers into master
headers.Copy mtr.Range("A1")
startRow = headers.Row + 1
startCol = headers.Column

Debug.Print startRow, startCol
'loop through all sheets
For Each ws In wb.Worksheets()
     'except the master sheet from looping
     'except sheet name with _data
     If ws.Name Like "*" & FIND_STR Then
        ws.Activate
        lastRow = Cells(Rows.Count, startCol).End(xlUp).Row
        lastCol = Cells(startRow, Columns.Count).End(xlToLeft).Column
        'get data from each worksheet and copy it into Master sheet
        
        Range(Cells(startRow, startCol), Cells(lastRow, lastCol)).Copy
        
     'Select & PasteSpecial with activating worksheet
        mtr.Activate '追記
        mtr.Range("A" & mtr.Cells(Rows.Count, 1).End(xlUp).Row + 1).Select　'追記
        
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False　'追記
     
        Application.CutCopyMode = False
     End If
Next ws

Worksheets("Master").Activate

End Sub

0Like

Are you sure you want to delete the question?