|
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
たとえばこんな感じです。
>単純なコピペコード等はできたのですが、条件が増えると上手く組むことができません・・
他にも条件があるのでしょうか?
|
|