【VBA】複数CSVの特定範囲を1つのワークシートにコピー/ペーストするコードの修正

VBA初心者です。
下記のような作業フローのVBAを作製しております。

1.VBAを搭載しているexcelファイルにシートを追加し、
　シート名に"VF"と名付ける。
2.任意のアドレスのフォルダを開き、
　フォルダ内のCSVファイルが複数選択できる状態になる
3.複数のCSVファイルを選択
4.CSVファイルを1つ開く
5.CSV中のB13～B39セルをコピー
6.1で追加したシート"VF"のB3～B29セルにペースト
　　※2サイクル目ではC3～C29セルにペースト
　　　3サイクル目ではD3～D29セルにペースト
　　　と、1列ずつペースト先が右にずれていく
7.CSVを閉じる
8.次のCSVファイルを1つ開く
9.5から繰り返し

このうち、作業フロー5,6にあたる
　Worksheets("DataSheet").Range(Cells(13, 2), Cells(39, 2)).Copy _
　Destination:=NewSheet.Cells(3, C1)
で「インデックスが有効範囲にありません」というエラーが表示され、
動作が停止してしまいます。
このコードの修正方法をご教示頂けないでしょうか。
よろしくお願いいたします。
以下に、作成したコードを記載いたします。
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
Sub csvcpy()

Dim PathGet As Variant
Dim DataSheet As Worksheet 'DataSheet = コピー元のファイル(csvファイル)
Dim NewSheet As Worksheet 'NewSheet = ペースト先のシート(シート"VF")
Dim SheetName As String

'CSVファイルの選択
PathGet = Application.GetOpenFilename( _
FileFilter:="CSVファイル(*.csv),*.csv", _
Title:="CSVファイルの選択", MultiSelect:=True)

'ファイルパスが取得できない場合
If IsArray(PathGet) = False Then
Exit Sub
End If

'ファイルパスが取得できた場合
Set NewSheet = Worksheets.Add() '新しいワークシートを生成
NewSheet.Name = "VF" 'ワークシート名にVFと記入
C1 = 2

If IsArray(PathGet) Then
For Each Filename In PathGet
SheetName = Dir(Filename)
Workbooks.Open Filename:=Filename 'CSVファイルを開く
Set DataSheet = ActiveSheet


Worksheets("DataSheet").Range(Cells(13, 2), Cells(39, 2)).Copy _
Destination:=NewSheet.Cells(3, C1)　'範囲指定&コピーペースト
C1 = C1 + 1

ActiveWorkbook.Close SaveChanges:=False 'CSVを閉じる
Next

End Sub
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿

No.2 ベストアンサー 回答者： Qchan1962 回答日時： 2021/08/04 10:00

こんにちは

＞Set DataSheet = ActiveSheet　　DataSheet　は　As Worksheet
＞Worksheets("DataSheet")
　DataSheet　はAs Stringとして使われている、、正しくありません

"DataSheet"と言う名前のシートがあれば良いのですが、、、
あと、シートがあった場合、、＃１様の指摘の通りです。、、まあ無いですよね。配列で開いているので同じ訳もなく、、、、シート名はファイル名になっているでしょうから、、

With DataSheet
.Range(.Cells(13, 2), .Cells(39, 2)).Copy _
Destination:=NewSheet.Cells(3, C1)
End With

または、
他にDataSheet を使用しないなら
　Set DataSheet = ActiveSheet　なので
DataSheetは不要で

Range(Cells(13, 2), Cells(39, 2)).Copy _
Destination:=NewSheet.Cells(3, C1)　'範囲指定&コピーペースト
でも動くかと、、、動くことが前提で

CSVファイルをExcelで開くと当然1シートなのでActiveSheetが対象になります。よって開く時Withなどで括る書き方もあるかな

With Workbooks.Open(Filename:=Filename)
他にも好みによって書き方は色々あるりますが

この回答へのお礼

ご回答ありがとうございます。ご記載頂いた通り、
原因はWorksheets(”DataSheet”)の一文で DataSheet が
Stringとして扱われ、冒頭の定義区分と異なってしまう所にありました。

ご記載頂いた修正文を反映させ、下記のコードで
望みの動作をさせることが出来ました。
ご教示頂きまして誠にありがとうございました。

Sub csvcpy()

Dim PathGet As Variant
Dim DataSheet As Worksheet 'DataSheet = コピー元のファイル(csvファイル)
Dim NewSheet As Worksheet 'NewSheet = ペースト先のシート(シート”VF”)
Dim SheetName As String

'CSVファイルの選択
PathGet = Application.GetOpenFilename( _
FileFilter:=”CSVファイル(*.csv),*.csv”, _
Title:=”CSVファイルの選択”, MultiSelect:=True)

'ファイルパスが取得できない場合
If IsArray(PathGet) = False Then
Exit Sub
End If

'ファイルパスが取得できた場合
Set NewSheet = Worksheets.Add() '新しいワークシートを生成
NewSheet.Name = ”VF” 'ワークシート名にVFと記入
C1 = 2

If IsArray(PathGet) Then
For Each Filename In PathGet
SheetName = Dir(Filename)
Workbooks.Open Filename:=Filename 'CSVファイルを開く
Set DataSheet = ActiveSheet

DataSheet.Range(Cells(13, 2), Cells(39, 2)).Copy Destination:=NewSheet.Cells(3, C1) '範囲指定＆コピーペースト
C1 = C1 + 1

ActiveWorkbook.Close SaveChanges:=False 'CSVを閉じる
Next

End If
End Sub

お礼日時：2021/08/04 23:23

No.1 回答者： めぐみん_ 回答日時： 2021/08/04 06:10

ありがちな回答ですけど。

Worksheets("DataSheet").Range(Cells(13, 2), Cells(39, 2)).Copy _
Destination:=NewSheet.Cells(3, C1)

　↓

With Worksheets("DataSheet")
.Range(.Cells(13, 2), .Cells(39, 2)).Copy _
Destination:=NewSheet.Cells(3, C1)
End With

この回答へのお礼

ご回答ありがとうございます。ご記載いただいた様に、
私の作製したコードでは、With～End Withの構文や、
Range内の範囲指定方法が正確に記載できておりませんでした。

またその後、Qchan1962様にご記載頂きましたように、
私のコードでは DataSheet という名称のシートが生成される機会がなく、
Worksheets("DataSheet")の記述にも不具合の要因があることが
わかりました。

以上2点を修正し、望むフローの動作が確認できました。
改めてご教示頂きましてありがとうございました。

お礼日時：2021/08/04 22:54