Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


20827 / 76738 ←次へ | 前へ→

【61321】Re:特定セルを別ブックへコピペして、保存を繰り返したい
回答  りん E-MAIL  - 09/4/26(日) 14:16 -

引用なし
パスワード
   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

たとえばこんな感じです。

>単純なコピペコード等はできたのですが、条件が増えると上手く組むことができません・・
他にも条件があるのでしょうか?

0 hits

【61320】特定セルを別ブックへコピペして、保存を繰り返したい kako 09/4/25(土) 23:55 質問
【61321】Re:特定セルを別ブックへコピペして、保存... りん 09/4/26(日) 14:16 回答
【61327】Re:特定セルを別ブックへコピペして、保存... kako 09/4/26(日) 18:07 お礼

20827 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free