VBA 取り込みファイルデータの結果を順番に貼り付ける時にデバック

Question

こんにちは。
今下記内容にて困っております。（画像にて困り事まとめました）
ご教示お願いいたします。
説明が不足しておりましたら、随時補足いたします。
（VBAベーシックを取得し、次にVBAスタンダード取得に向け勉強中のレベルです）

VBAにて、データファイル（Excel)　を取り込み最大水量・総水量・判定した結果を指定したセルに貼り付けまた散布図・ヒストグラムを作成するVBA（下記コード参照。字数制限で内容の影響ない部分はカットしました）を作成しました。（Oiffce365にて作成中、使用する環境はOffice2016）
困っていることは、追加でVBAで新たなデータファイルを取り込み解析結果を	
前の解析結果の下の空白枠に出力しようとして24行目でデバック(実行時エラー９　	
インデックスが有効範囲にありません)が発生してしまいます。	
またグラフも各解析結果のように前グラフの下の空白に張り付けていく方法はありますか。

コード全体
Sub ファイルを開く()

Dim Target As Variant
Dim Ret As String                       
Dim Fso As Object

Target = Application.GetOpenFilename("Excelブック,*.xl??")
If Target = "False" Then Exit Sub
Workbooks.Open Target


 
'Target = ActiveWorkbook.FullName

Set Fso = CreateObject("scripting.filesystemobject")
Ret = Fso.getbasename(Target)  
Dim a As String

a = 35
ThisWorkbook.Activate
Do Until Sheet1.Range("E" & a) = ""
a = a + 2
Loop
Range("E" & a).Value = Ret
                     
With Workbooks("???????.xlsm")

    .Worksheets("sheet1").Range("E35") = Ret
    .Worksheets("sheet1").Range("B69") = Ret
    End With
MsgBox Target
Workbooks(Target).Activate     →実行時エラー９　インデックスが有効範囲にありません
Sheets("sheet2").Select

Dim BeforePos As Long
Dim U As Variant
Dim U2 As Variant

BeforePos = Range("R6").End(xlDown).Row
    Cells(BeforePos + 2, 22).Formula = "=MAX(R6:R" & BeforePos & ")"
    
    U = Cells(BeforePos + 2, 22).Value

Workbooks("???????.xlsm").Worksheets("sheet1").Range("W35") = U

BeforePos = Range("R6").End(xlDown).Row
    Cells(BeforePos + 3, 22).Formula = "=SUM(R6:R" & BeforePos & ")"
    U2 = Cells(BeforePos + 3, 22).Value

Workbooks("???????.xlsm").Worksheets("sheet1").Range("AG35") = U2


If U < 2 Then
    Workbooks("???????.xlsm").Worksheets("sheet1").Range("AN35") = "?Z"
Else
    Workbooks("???????.xlsm").Worksheets("sheet1").Range("AN35") = "?~"

End If
  
  
Dim ThisSheet_Name As String
    ThisSheet_Name = ActiveSheet.Name
    With Charts.Add
        .Location Where:=xlLocationAsObject, Name:=ThisSheet_Name
    End With
 
 ActiveChart.SeriesCollection.NewSeries          '??????R?[?h???????G???[??????
    With ActiveChart.SeriesCollection(1)
        .ChartType = xlXYScatter    '?U?z?}
        .XValues = Range("A6", Range("A6").End(xlDown))    'X??????????w??
        .Values = Range("R6", Range("R6").End(xlDown))
       
    End With
  
  ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = True
  ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Text = "????"
 
  ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
  ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = "????"


Dim ChartObj As Object  '?????????Q?l
    Set ChartObj = ActiveSheet.ChartObjects(1)
    

    With ChartObj.Chart
    .HasTitle = False
    .HasLegend = False
    '.ChartTitle.Text = Ret

End With

Dim tmp As Variant, I As Long
tmp = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Values
For I = 1 To UBound(tmp)
        If tmp(I) >= 2 Then
            With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(I)
                .Interior.ColorIndex = 3
                .Interior.Pattern = xlSolid
            End With
        End If
    Next I

With ChartObj
    .Top = Range("B56").Top
    .Left = Range("B56").Left
    .Height = 234.425
    .Width = 350.929 '????????

End With
                   
ChartObj.Copy
Workbooks("???????.xlsm").Activate
Sheets("Sheet1").Select
Range("B71").Select
ActiveSheet.Paste



'?q?X?g?O????
Dim pvtChart As Shape
    
    Workbooks(Ret + ".xlsx").Activate
    
    ActiveSheet.Range("R6", Range("R6").End(xlDown)).Select
    
    Set pvtChart = ActiveSheet.Shapes.AddChart2(366, xlHistogram)
   
'?O???t?^?C?g??
With pvtChart.Chart
    .HasTitle = False      

End With

ママチャリ · Accepted Answer

No.2です。補足コメント、ありがとうございます。
しかし、間違ったコードと「うまくいきません」だけでは、的を得た回答は出来かねます。
せめて、「どの行で」「どういったエラーが出るのか」を書いて頂けないと・・・。
（文法エラーなのか、実行時エラーなのか。それともエラーは発生しないが結果が想定と違う・・・等々）
それらを一括りにして「うまくいかない」っていう質問者が結構多いですが、回答側から見たら、「へっ？」って感じです。

提示のコードを見る限りで回答するならば・・・。

①変数dがStringで定義されているのに、加算している（結果としては問題なさそうだが）。

②＞Do Until Sheet1.Range("AN" & d) = ""
Sheet1って何？
Worksheets("sheet1")の間違い？

③突然登場した変数U、U2の意味が分からないので、回答のしようが無い。
（「最初に提示されているコードを読め」ということであれば、お断りします）

④「Workbooks("???????.xlsm")」「"?Z"」等の「?」って何？文字化け？

まずは、この辺の見直し、および、補足をすべきでは？
（補足して頂いても回答を保証するものではありませんので、気に入らなければスルーしてください）

Qchan1962 · Answer

＃４　失礼、
Workbooks("自動解析.xlsm").Worksheets("sheet1").Range("AN" & d) = 
です。申し訳ありません。

Qchan1962 · Answer

>解析結果が出力しますが、上記コードでは判定が空白のままになってしまします。
If U < 2 Then　→Uは取り込みファイルの最大水量です。
Workbooks("自動解析.xlsm").Worksheets("sheet1").Range("AN35") = "〇"
Else
Workbooks("自動解析.xlsm").Worksheets("sheet1").Range("AN35") = "×"
End If

すでに的確な指摘、回答もありますが、仮に
Do Until Sheet1.Range("AN" & d) = ""　で
せっかく結合セルの行番号を抽出出来ても、反映されていませんね。
これでは同じ場所Range("AN35") に書き込まれてしまいます。

If U < 2 Then　→Uは取り込みファイルの最大水量です。
Workbooks("自動解析.xlsm").Worksheets("sheet1").Range("AN & d") = "〇"
Else
Workbooks("自動解析.xlsm").Worksheets("sheet1").Range("AN & d") = "×"
End If
例として、このような感じになります。
初歩的なミスや見落としがあるようなので、コードを整理された方が良いように思いますよ。

ぱっと見、やばそうなコードをローカルに移してデバッグする気にはなりませんので。

ママチャリ · Answer

Workbooks.Open Target

上記のコードでブックをオープンしているようですが、これを次のように変えるて、オープンと同時にブック名を変数に格納してみてはいかがでしょうか。以降、この変数でブックの特定ができるはずです。

「ブック名を格納する変数」 = Workbooks.Open(Target).Name

さらに言うと・・・。
「Workbooks(”ブック名”).～」って書き方は無粋です。
オープンした時点で、そのブックをオブジェクト変数に格納し、以降は、そのオブジェクト変数でブックを指定すべきです。
こんな感じです。

Set wb = Workbooks.Open(Target)
    ・
    ・
    wb.Activate

めぐみん_ · Answer

http://officetanaka.net/excel/vba/filesystemobject/filesystemobject18.htm

こちらで拡張子も含んだファイル名を取得して『その変数名を』中に入れて上げたら宜しいのかも。

VBA 取り込みファイルデータの結果を順番に貼り付ける時にデバック

＃４ 失礼、

>解析結果が出力しますが、上記コードでは判定が空白のままになってしまします。

No.2です。

Workbooks.Open Target

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

＃４　失礼、