dポイントプレゼントキャンペーン実施中!

はじめましてほぼ初心者に近い者なのですが
VBAの条件式のことで質問がありまして
※ コードの内容はgooで回答いただいていたコードを使わせてもらい、少しだけ変更したものです。申し訳ありません。
以下のマクロ
'-----------------------------------------------------------
Sub CSV_READ()
Dim MyObj As Object
Dim MyFol As String
Dim MyFnm As String
Dim MyStr As String
Dim i As Long
Dim n As Long
Dim n1 As Long
'フォルダを選択する
Set MyObj = CreateObject("Shell.Application") _
.BrowseForFolder(0, "SelectFolder", 0)
'選択なければ処理を抜ける
If MyObj Is Nothing Then Exit Sub
MyFol = MyObj.self.Path & "\"
MsgBox MyFol & "を処理します。"
Set MyObj = Nothing
Application.ScreenUpdating = False
'データ読み込みシートを選択
Sheets("ツール").Select
With Sheets("ツール")
'Dir関数を使って指定フォルダ内csvファイルを順次処理
MyFnm = Dir(MyFol & "*.csv")
Do Until Len(MyFnm) = 0&
i = i + 1
'データエリアを取得してセット先を変更
n = IIf(n = 0, 1, n + n1)
'外部データ取り込みを利用
With .QueryTables.Add(Connection:="TEXT;" & MyFol & MyFnm, _
Destination:=.Range("A" & n))
.AdjustColumnWidth = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 2
.TextFileCommaDelimiter = True
.Refresh False
n1 = .ResultRange.Rows.Count
.Parent.Names(.Name).Delete
.Delete
End With
'次のファイルへ
MyFnm = Dir()
Loop
End With
If i > 0 Then
MyStr = i & "個のファイルを処理しました。"
Else
'検索結果が0なら
MyStr = "検索条件を満たすファイルはありません。"
End If

'-------------------------------------------------------------------
'処理2
'-------------------------------------------------------------------
' 別シートに反映
Range("M2:M3020").Select
Selection.Copy
Sheets("Sheet2").Select
Range("C4").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("E2:E3020").Select
Selection.Copy
Sheets("Sheet2").Select
Range("D4").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("F2:F3020").Select
Selection.Copy
Sheets("Sheet2").Select
Range("E4").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("C2:C3020").Select
Selection.Copy
Sheets("Sheet2").Select
Range("G4").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
MsgBox MyStr
End Sub
'-----------------------------------------------------------
以上
'-----------------------------------------------------------
こちらを実行するとダイアログが出現しCSVファイルのみが格納されているフォルダまで進め、
フォルダ指定することで中のCSVファイルの中身のセルを全てを連結させて表示し
指定行だけをコピーして別シートの指定セルに貼り付けするという繰り返しマクロなのですが、

私が知りたいことは
CSVファイルが格納されているフォルダ
A-TESTフォルダ
B-TESTフォルダ
C-TESTフォルダ
D-TESTフォルダ というように

A-TESTフォルダを指定すると上の処理2欄を実行し
B-TESTフォルダを選択すると
("C4")←貼り付け先を("E4")にする。
("D4")の箇所を⇒("F4")に。
というような感じのCase文?で作ることができる条件式をご教授頂きたいのですが
書き方に行き詰ってしまい困っております。

どこか説明不足や、質問内容がわかりにくいかもしれません。。。。
長々となってしまいお手数お掛けしますがご意見お待ちしております。
よろしくお願いします。

A 回答 (1件)

いろいろな方法があるかと思いますが、


できる限り、同じ処理を記述しないよう、貼り付け先を変数にしてみました。
Dim Pasterange1 As String
Dim Pasterange2 As String
Select Case MyFol
Case "A-TEST"
Pasterange1 ="C4"
Pasterange2 ="D4"
Case "B-TEST"
Pasterange1 ="E4"
Pasterange2 ="F4"
Case "C-TEST"
Pasterange1 ="G4"
Pasterange2 ="H4"
End Select

'処理2改良
別シートに反映
Range("M2:M3020").Select
Selection.Copy
Sheets("Sheet2").Select
Range(Pasterange1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("E2:E3020").Select
Selection.Copy
Sheets("Sheet2").Select
Range(Pasterange2).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("F2:F3020").Select
Selection.Copy
Sheets("Sheet2").Select
Range("E4").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("C2:C3020").Select
Selection.Copy
Sheets("Sheet2").Select
Range("G4").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
MsgBox MyStr
End Sub
    • good
    • 0
この回答へのお礼

返事遅くなりました。

上記の貼り付け先を変数に変えて試してみたのですが
Range(Pasterange1).Select
の箇所で 'Range' メソッドに失敗しました:'_Global'オブジェクト

とゆうエラーが発生しまして
対処方法に困っています><;
すいません。。もう一度ご教授お願います;;

お礼日時:2007/12/06 07:25

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