| 
    
     |  | kako さん、こんにちわ。 
 >ファイルAのI列に「住所」J列に「氏名」が入力されています(同じ行で対になっております)
 >ファイルBのA1に「住所」、A2に「氏名」を貼り付けます
 >このとき、A1には「東京都」と頭に付けてから住所を貼り付けます
 >ファイルBを、貼り付けたセルA1の「東京都」を取った住所の名前で保存します
 >
 >ファイルA、B、新たに保存されるファイルは同じフォルダにあります
 
 Sub test()
 Dim wb(1 To 2) As Workbook
 Dim II As Long, pt As String
 '
 'AもBも開かれているとして。
 With Application
 Set wb(1) = .Workbooks("A.xls")
 Set wb(2) = .Workbooks("B.xls")
 '保存先フォルダ
 pt = wb(2).Path
 If Right(pt, 1) <> .PathSeparator Then pt = pt & .PathSeparator
 End With
 '
 II = 6
 '対象のシートは共にSheet1だとして。
 Do
 With wb(1).Worksheets("Sheet1").Cells(II, "I")
 If .Value = "" Then Exit Do '住所欄がカラだと終了
 '転記して保存
 wb(2).Worksheets("Sheet1").Range("A1").Value = "東京都" & .Value
 wb(2).Worksheets("Sheet1").Range("A2").Value = .Offset(0, 1).Value
 wb(2).SaveAs pt & .Value & ".xls"
 End With
 II = II + 1
 Loop
 '全処理終了時に閉じておく
 wb(2).Close
 '
 Erase wb
 End Sub
 
 たとえばこんな感じです。
 
 >単純なコピペコード等はできたのですが、条件が増えると上手く組むことができません・・
 他にも条件があるのでしょうか?
 
 |  |