セルの値からシートを検索してデータを取得してコピペする

投稿者 : きみどり     投稿日時 : 2021/03/23(Tue) 18:08:04     OS : Windows 10     EXCEL : Excel 2016

---

当方、VBA初心者です。VBAで複数シートからの複数セルのデータを取得して１枚のシートにまとめたいと思っていますがうまく機能しません。構成は次の通りです。

シート；Report　"とりまとめのシート
シートあ、い、う　"データのあるシート

Reportシートの”あ”のある行のG2セルから横に、”シートあ”から取得したデータを行列を入れ替えて値のみ貼り付けたいです。よろしくお願いいたします。

Dim i As Long
Dim wsMRD As Worksheet
Dim strSN As String

Set wsMRD = Worksheets("Report")
    
    With wsMRD
        i = 0
        Do
            strSN = Cells(2 + i, "B").Value
            If strSN = "" Then Exit Do
            Sheets(strSN).Range(""L3:L4,L7:L15,L18:L19"").Select
            Selection.Copy
            .Range("G2").PasteSpecial Paste:=xlPasteValues, Transpose:=True
 

        i = i + 1
        Loop
    End With
End Sub

投稿者 : ヘンリー     投稿日時 : 2021/03/23(Tue) 21:13:50

---

＞うまく機能しません。
まずは、うまく機能するかしないかの前に、文法エラーがあります。
初心者であれば、エラーを無視してはいけません。
(慣れている人ならば、エラーの内容を見なくても、コードを見て修正できます)

コンピュータが、わざわざ「○〇エラー」と返してきてくれているのですから、
そのエラーについて調べてみる事が大切です。
これをしないと、VBAはできるようにはなりません。

＞Sheets(strSN).Range(""L3:L4,L7:L15,L18:L19"").Select
ダブルコーテーションの意味、使い方について調べてみて下さい。
ActiveのシートでなければSelectメソッドはできません。

【蛇足】
厳密にいうと、Worksheets("Report")とSheets(strSN)のシートには違いがあります。
Sheetsの中に、Worksheetsがあり、初期状態からある"Sheet1"という名前のシートは、Worksheetです。
Sheetsの中には、Excel4.0マクロシートなどが含まれているのです。
シート名の所で、右クリックの挿入を選んでみて下さい。
そこに出てくるものは、全てSheetです。そして、その中にWorksheetがあります。

投稿者 : きみどり     投稿日時 : 2021/03/24(Wed) 09:47:16

---

■[返信 1] ヘンリーさん（2021-03-23 21:13:50）の記事
＞ ＞うまく機能しません。
＞ まずは、うまく機能するかしないかの前に、文法エラーがあります。
＞ 初心者であれば、エラーを無視してはいけません。
＞ (慣れている人ならば、エラーの内容を見なくても、コードを見て修正できます)
＞
＞ コンピュータが、わざわざ「○〇エラー」と返してきてくれているのですから、
＞ そのエラーについて調べてみる事が大切です。
＞ これをしないと、VBAはできるようにはなりません。
＞
＞ ＞Sheets(strSN).Range(""L3:L4,L7:L15,L18:L19"").Select
＞ ダブルコーテーションの意味、使い方について調べてみて下さい。
＞ ActiveのシートでなければSelectメソッドはできません。
＞
＞ 【蛇足】
＞ 厳密にいうと、Worksheets("Report")とSheets(strSN)のシートには違いがあります。
＞ Sheetsの中に、Worksheetsがあり、初期状態からある"Sheet1"という名前のシートは、Worksheetです。
＞ Sheetsの中には、Excel4.0マクロシートなどが含まれているのです。
＞ シート名の所で、右クリックの挿入を選んでみて下さい。
＞ そこに出てくるものは、全てSheetです。そして、その中にWorksheetがあります。

ヘンリーさん
ありがとうございます！
何度も修正を繰り返した挙句に、投稿させていただいたのですが
＞ ＞Sheets(strSN).Range(""L3:L4,L7:L15,L18:L19"").Select
こちらは、この投稿に書き写す際にダブってしまいましたので、実際の構文では１つのみです。

＞ ActiveのシートでなければSelectメソッドはできません。
こちらについても、copyに変えたりしたのですが、そうすると「インデックスが有効範囲にありません」とデバックが返り、Rangeが有効でないのだなとは思ったのですが、その先へ進めませんでした。

＞ 【蛇足】
このWorksheetsとSheetsの関係が全く理解できませんでした。
strSNをStringとしたのは、インデックスでなくシートの名前を代入したかったためなのですが、最初はas Worksheetとしておりました。Stringに変更してようやく代入できたようなのですが、今度ははRangeオブジェクトで引っかかってしまっております。

長々と書いてしまいましたが、本日もまた構文と戦っていきますので、さらなるヒントがありましたらご教授ください。

投稿者 : ヘンリー     投稿日時 : 2021/03/24(Wed) 13:57:52

---

Sub Sample()

 

    Dim i As Long

    Dim wsMRD As Worksheet

    Dim strSN As String

   

    Set wsMRD = Worksheets("Report")

   

    With wsMRD

        i = 0

        Do

            strSN = Cells(2 + i, "B").Value

            If strSN = "" Then Exit Do

            Worksheets(strSN).Select

            Range("L3:L4,L7:L15,L18:L19").Select

            Selection.Copy

            .Range("G2").PasteSpecial Paste:=xlPasteValues, Transpose:=True

            i = i + 1

        Loop

    End With

End Sub

＞「インデックスが有効範囲にありません」

このエラーは、該当のワークシートが見つからない時に出ます。

Copyに変えたからではないと思いますが、私にはいまいちわかりません。すいません。



＞このWorksheetsとSheetsの関係が全く理解できませんでした。

説明が良くなかったようです。すいません。

VBAとは関係なく、シート名の所で右クリックして挿入してみて下さい。(＋記号ではなく、ワークシート名の所で挿入)

すると、挿入というウィンドが表示されます。このウィンドに表示されている物がSheetsです。

Sheetsには、Worksheetsも入っていますが、グラフというシートや、Excel4.0マクロなどというシートも入っています。



上記のコードで、ご希望通り動くか試してみて下さい。

又、上記コードをコピー＆ペーストしtも良いですが、

必ず1回は、ステップイン実行をして、1行1行結果を確認する作業をして下さい。

私もステップイン実行で覚えていきましたし、この手間をかける人は、

皆VBAができるようになっています。

この手間を省く人は、できるようになる人は少ないです。



＞本日もまた構文と戦っていきますので

是非、頑張ってください。応援しております。

投稿者 : きみどり     投稿日時 : 2021/03/24(Wed) 16:46:56

---

ヘンリーさん
再びご返信いただきありがとうございます！！！ステップ実行とアドバイスにより、走るようになりました！
＞「インデックスが有効範囲にありません」
おっしゃる通り、該当のワークシートが見つからない時のデバックでした。
SELECTでなくCOPYのまま、「Application.ScreenUpdating」というものを入れ込んでみました。
またシート名で挿入の箇所を確認してみました。おっしゃる通りグラフやExcel4.0マクロが入っていました。
WorksheetsとSheetsの関係については、引き続き勉強していきます。

ですが、もう一つ、「On Error Resume Next」としたためか、エラーの行には直前の処理データが入るようになってしまいました。
エラーを無視して（エラー行は空白のまま）次に行ってほしいのですが、
このエラー処理について、アドバイスいただけると嬉しいです。

Dim i As Long
Dim wsMRD As Worksheet
Dim strSN As String

Set wsMRD = Worksheets("Report")
On Error Resume Next
    
    Application.ScreenUpdating = False
    With wsMRD
        
        i = 0

        Do
            strSN = Cells(2 + i, "B").Value
            If strSN = "" Then Exit Do
            Sheets(strSN).Range("L3:L4,L7:L15,L18:L19").Copy
            .Cells(2 + i, "G").PasteSpecial Paste:=xlPasteValues, Transpose:=True
 

        i = i + 1
        Loop
    End With
    Application.ScreenUpdating = True
End Sub

投稿者 : ヘンリー     投稿日時 : 2021/03/24(Wed) 21:51:06

---

大変申し訳ございません。
私の頭の悪さでは、On Error Resume Nextは使いこなせません。

＞エラーの行には直前の処理データが入るようになってしまいました。
このことから、コピーの時にエラーが発生して、
コピーはできずにペーストしてしまっているのかと思いましたが、
エラーが発生した時点で、Application.CutCopyMode = Falseになっていたので、
当方で試したところ、直前の処理データは入らず、セルには何も入りませんでした。

ちなみに、Application.CutCopyModeとは、
Trueなら右クリックでコピーしたときに、セルが点線で囲まれて表示されていれる状態
Falseなら右クリックでコピーしたときに、セルが点線で囲まれて表示されていない状態の事です。

きみどり様は、頑張っておられるので、何とかお力になれればと思うのですが…

私は、On Error Resume Nextは使いません。
参考までに、私が始めたての頃に使っていたエラー処理方法のサンプルを載せます。

Dim i As Long
Dim wsMRD As Worksheet
Dim strSN As String

On Error GoTo Sheet_Err
Set wsMRD = Worksheets("Report")
    
    Application.ScreenUpdating = False
    With wsMRD
        
        i = 0

        Do
        
            strSN = Cells(2 + i, "B").Value
            If strSN = "" Then Exit Do
            
            On Error GoTo Copy_Err
            Sheets(strSN).Range("L3:L4,L7:L15,L18:L19").Copy
            On Error GoTo Paste_Err
            .Cells(2 + i, "G").PasteSpecial Paste:=xlPasteValues, Transpose:=True
 
Next_Process:
        i = i + 1
        Loop
    End With
    Application.ScreenUpdating = True
    On Error GoTo 0
    
    Exit Sub
    
Sheet_Err:
    MsgBox Err.Description, vbExclamation
    Exit Sub
       
Copy_Err:
    MsgBox Err.Description, vbExclamation
    Resume Next_Process

Paste_Err:
    MsgBox Err.Description, vbExclamation
    Resume Next_Process

End Sub

この方法だと、どの命令でエラーが発生したかが分かりやすく、
エラーの内容も分かるので、エラーの対応がやりやすいのと、
戻りの位置も確実に指定できることです。

ただし、ループの中から一旦出てから、またループの中に戻るので、
第三者が修正する可能性がある場合は、嫌われるコードです。

エラーが出る可能性のある命令については、プロシージャを分けるという方法があります。
Sub Main()
Dim i As Long
Dim wsMRD As Worksheet
Dim strSN As String

Set wsMRD = Worksheets("Report")
On Error Resume Next
    
    Application.ScreenUpdating = False
    With wsMRD
        
        i = 0

        Do
            strSN = Cells(2 + i, "B").Value
            If strSN = "" Then Exit Do
            If CopyRange(Sheets(strSN).Range("L3:L4,L7:L15,L18:L19")) = True Then
                .Cells(2 + i, "G").PasteSpecial Paste:=xlPasteValues, Transpose:=True
            End If

        i = i + 1
        Loop
    End With
    Application.ScreenUpdating = True

End Sub

Function CopyRange(rngRange As Range) As Boolean
On Error GoTo Err_Exit

    CopyRange = False

    rngRange.Copy
    
    CopyRange = True
    Exit Function
    
Err_Exit:
    MsgBox Err.Description

End Function

投稿者 : きみどり     投稿日時 : 2021/03/25(Thu) 11:31:52

---

ヘンリーさん
素敵なエラー処理例をいただき、本当にありがとうございます!!

＞当方で試したところ、直前の処理データは入らず、セルには何も入りませんでした。
という記載に驚きました。同じコードでも別の結果が返ってくるとは、、、本当に奥が深いです。。

コピペするデータが他に複数あり、当方の処理に合うものを頂いたエラー処理サンプルで検証してみます。
まずは、ヘンリーさんのご協力に本当に感謝いたします!!!!!

投稿者 : きみどり     投稿日時 : 2021/03/30(Tue) 16:37:44

---

ヘンリーさん
大変遅くなりましたが、最初にご教示いただいたエラー処理の方で解決に至りました。当方には理解しやすく、おっしゃる通りエラー箇所が分かりやすいため修正しやすかったです。
大変参考になりました。ありがとうございました。