VBA 他ブックのセルの値を1セルずつ代入したい
昨日↓でお世話になりました。
http://oshiete1.goo.ne.jp/qa4299999.html
おかげさまでだいぶ先に進むことができました。
ですがまた行き詰ってしまったので、お力を借りれたらと思い質問させていただきます。
昨日ご教授いただいたコードでは、「管理表.xls」のコマンドボタンを押すと、同一フォルダ内にあるブック「*予定表*.xls」内のシート「*予定?」の固定の範囲
「G2,H2,N3,O3」を「管理表.xls、sheet2、A1:D4」に
「B14:I44」を「管理表.xls、sheet2、A2:H32」に
まだファイル、シートがある場合はループでそれらの次の行に値をいれていくことができたのですが、固定範囲のうちの「G2,H2,N3,O3」を、「管理表.xls、sheet2、A2:H32」のA~D列全てに付けたいのです。
なんかわかりづらい表現になってしまいましたが、
____A___B___C___D____E____F____G____H____I____J_____K____L
1 G2 G2 N2 O3 B14 C14 D14 E14 F14 G14 H14 I14
2 G2 G2 N2 O3 B15 C15 D15 E15 F15 G15 H15 I15
3 G2 G2 N2 O3 B16 C16 D16 E16 F16 G16 H16 I16
・
・
・
という感じにしたいんです。どうかご教授お願いします。
一応コードを載せておきます。
Sub 予定()
Dim Pn As String
Dim Fn As String
Dim ws As Worksheet
Dim r As Range
Dim v, i As Integer
Pn = ActiveWorkbook.Path
ChDir Pn
Fn = Dir("*予定表*.xls")
v = Array("N3", "O3", "G2", "H2")
Set r = ThisWorkbook.Worksheets("Sheet2").Range("A1")
Do Until Fn = ""
Workbooks.Open Filename:=Fn
For Each ws In Worksheets
If ws.Name Like "*予定?" Then
With ws
For i = 0 To 3
r.Offset(0, i).Value = .Range(v(i)).Value
Next
r.Offset(1).Resize(31, 8).Value = .Range("B14:I44").Value
Set r = r.End(xlDown).Offset(1)
End With
End If
Next
Workbooks(Fn).Close SaveChanges:=False
Fn = Dir()
Loop
End Sub
++++++++++++++++++++
OS ⇒Windows XP
Version⇒Excel 2000
++++++++++++++++++++
お礼
理由がわかりました。 今回の問題の場合ファイル名ですので「\」が文字列に入ることはないのでNo,1の方の関数でやりましたが普通の文字列の場合(「\」も入る可能性のある文字列)EUCでエンコードした後、urlencodeしてSJISに戻せばいいんですね、今後はそのようにプログラミングします。 ありがとうございました。