• はてなアカウントでログイン
• 無料ユーザー登録

ベストアンサー

• きゃづみぃ2013/03/22 17:25:41

  満足400pt

  まず 「原本_ツール.xls」ですが、ボタンのクリックは プライベートなので そのまま呼べません。
  
  なので
  「原本_ツール.xls」に以下のソースを 追加してください。
  
  ボタンのあるシートに

  Sub Button1_Click()
      Call CommandButton1_Click
  End Sub
  

  
  

  標準モジュールに

  Sub Button_Click()
       Sheets("Sheet1").Button1_Click
  End Sub
  

  
  
  

  あと 実行用のエクセルですが、個人フォルダに入れてください。
  つまり「リスト.xls」と「原本_ツール.xls」と同じところということです。
  

  Sub main()
      s1 = "リスト.xls"
      s2 = "原本_ツール.xls"
      
      Workbooks.Open ThisWorkbook.Path & "\" & s1
  
      For a = 2 To Rows.Count
          b1 = Workbooks(s1).Sheets("Sheet1").Cells(a, "A")
          If b1 = "" Then Exit For
          
          b2 = Workbooks(s1).Sheets("Sheet1").Cells(a, "B")
          b3 = Workbooks(s1).Sheets("Sheet1").Cells(a, "C")
          
          Workbooks.Open ThisWorkbook.Path & "\" & s2
          
          Workbooks(s2).Sheets("Sheet1").Cells(2, "C") = b1
          Workbooks(s2).Sheets("Sheet1").Cells(3, "C") = b2
          Workbooks(s2).Sheets("Sheet1").Cells(4, "C") = b3
          
          Application.Run s2 & "!Button_Click"
          ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & b1 & ".xls"
          Workbooks(b1 & ".xls").Close
      Next a
      
      Workbooks(s1).Close
          
  End Sub
  

  
  

  なお シート名は 画像にあるものを用いています。

  スター

  • 

    1件のコメントを見る

  • きゃづみぃ 2013/03/22 19:47:06

    もし オフィス2007以降で実行するならば 拡張子を xlsと指定しているため、生成されたファイルが 正しく読めない場合があります。

    その場合は、
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & b1 & ".xls" 
    
    ↓
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & b1 & ".xls", FileFormat:=xlExcel8 
    
    とします。
    

    スター

その他の回答

• Hiroto2013/03/22 19:36:12

  満足100pt

  質問文の動作がよく分からなかったので、勝手に変えさせていただきました。
  違かったらすいません。
  ①ボタンを押すと、同じフォルダにあるリスト.xlsxからリストのデータを読み込む
  ②読み込んだデータを、原本_ツール.xlsに反映
  ③反映したら、同じフォルダに「(名前).xls」という名前で保存する
  ④保存したファイルを閉じる
  ⑤「名前」の数だけ繰り返す
  
  ※質問文に書いてあるファイル名と、画像のファイル名が違っていたので、画像の方に合わせました。

  • リスト.xlsx
  • 原本_ツール.xls
  
  

  以下で動作すると思います。※先に「ボタン 1」に「Test_1」を実行するように設定しておいてください。

  Sub Test_1()
  Dim tSht
  Dim lSht
  Dim aSht
  Dim lr
  Dim lc
  Dim x
  Dim y
  Dim a()
  
  Workbooks.Open ("C:\この部分は書き換えてください\個人ファイル\リスト.xlsx")
  Set tSht = ThisWorkbook.Worksheets("Sheet1")
  Set lSht = Workbooks("リスト.xlsx").Worksheets("Sheet1")
  lr = Range("a1").End(xlDown).Row
  lc = Range("a1").End(xlToRight).Column
  ReDim a(lc - 1)
  
  For x = 2 To lr
      
      For y = 0 To lc - 1
          a(y) = lSht.Cells(x, y + 1).Value
      Next
      
      Workbooks.Add
      Set aSht = ActiveWorkbook.Worksheets("Sheet1")
      tSht.Cells.Copy (aSht.Cells)
  
      For y = 0 To lc - 1
          aSht.Cells(y + 2, 3).Value = a(y)
      Next
      
      ActiveWorkbook.SaveAs a(0) & ".xls", xlWorkbookNormal
      ActiveWorkbook.Close
  Next
  
  Workbooks("リスト.xlsx").Close
  End Sub
  

  
  

  このコードは、「リスト.xlsx」にあるリスト(表)が縦にも横にも伸びても、対応できるようになっていると思います。
  また、「原本_ツール.xls」の最初からある表をコピーして「(氏名).xls」を作るようになっているので、表やその周りに塗りつぶしなどの書式設定をしている場合、これもコピーできると思います。

  スター

  • 

    1件のコメントを見る

  • Hiroto 2013/03/22 22:20:48

    すいません。「Workbooks.Open」のところのアドレス、訂正しました。
    
    単にファイル名ではなく、ファイルのフルネームじゃないといけないみたいです。

    スター

この質問へのコメント

質問の情報

登録日時

2013-03-22 16:10:04

終了日時

2013-03-25 21:13:53

回答条件

1人5回まで

この質問のカテゴリ

• コンピュータ

この質問に含まれるキーワード

人気の質問

• この英文どうなってますか？ The boy seemed to be waiting for his mother to come.（その少年は母親が来…匿名質問者112日前
• 不定詞の形容詞的用法らしいんですけど、副詞的用法と書いたら✖️ですか？ I want to buy a book to read …匿名質問者112日前
• 日向陽葵という○V女優が好きなのですが似ている○V女優はいますか匿名質問者20時間前
• 共通テストで使われるプログラミング言語は共通テスト特有の言語と聞いたのですが、受験勉強で身につけたプ…匿名質問者120時間前
• 内定してほしいポケモンはいますか？匿名質問者21時間前

メニュー

• 質問一覧
• カテゴリ一覧
• 無料ユーザー登録
• 人力検索はてなトップ

PC版

• お問い合わせ
• ヘルプ
• お知らせ
• はてなトップ