Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10全般 : Excel 2016)
特定のフォルダを複製し、Excelのセルで指定したファイル名で保存
投稿日時: 19/07/26 00:56:06
投稿者: vicky_T

やりたいこと
『内容の同じフォルダを名前を変えて複数作成したい』
 条件
 ・コピー元フォルダの中にファイルが存在する。内容を含めて複製。
 ・Excelのシート『フォルダ作成』セルB2にコピー元フォルダパスの設定。
 ・同じシートのセルB4から下のB列にコピー先のフォルダ名。(作成するフォルダ数は不定)
 ・保存場所は作業を行っているExcelと同じフォルダ。
 
 
Sub CopyFolder()
  Dim FSO As Object 'ファイルシステムオブジェクト
  Dim APath As String 'コピー元
  Dim BPath As String 'コピー先
   APath = Sheets("フォルダ作成").Range("B2") 'コピー元フォルダパスの設定
   BPath = ThisWorkbook.Path & "\" & Cells(4, 2) 'コピー先フォルダパスの設定(フォルダ名変更)
    'メインオブジェクトの生成
    Set FSO = CreateObject("Scripting.FileSystemObject")
    'フォルダのコピー(上書き)
    FSO.CopyFolder APath, BPath
    'オブジェクト変数のクリア
    Set FSO = Nothing
End Sub
 
上記の通り、1つのフォルダを作成することはできたのですが、
これをExcelのシート『フォルダ作成』セルB4から下にずっと入力されているフォルダ名で
自動的に次々と作成されるようにしたいのですが、うまくいきませんでした。
 
Sub CopyFolder2()
  Dim FSO As Object 'ファイルシステムオブジェクト
  Dim APath As String 'コピー元
  Dim BPath As String 'コピー先
  Dim i As Long
    'メインオブジェクトの生成
    Set FSO = CreateObject("Scripting.FileSystemObject")
    APath = Sheets("フォルダ作成").Range("B2") 'コピー元フォルダパスの設定
  For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row
    BPath = ThisWorkbook.Path & "\" & Cells(i, 2) 'コピー先フォルダパスの設定(フォルダ名変更)
    'フォルダのコピー(上書き)
    FSO.CopyFolder APath, BPath
  Next i
    'オブジェクト変数のクリア
    Set FSO = Nothing
End Sub
 
 
拙い説明で申し訳ありません。
どなたか教えて頂けませんでしょうか。
どうぞよろしくお願い致します。
 
 

回答
投稿日時: 19/07/26 04:40:02
投稿者: simple

コードを拝見しますと、
B列ではなくA列の最終行を使用していますが、
そこは大丈夫ですか?

回答
投稿日時: 19/07/26 20:13:48
投稿者: WinArrow
投稿者のウェブサイトに移動

おそらく simpleさんのご指摘で解決すると思いますが、
  
質問の仕方で、注意していただきたいところがあります。
  
 >うまくいきませんでした。
これだけでは、あなたの困っていることが伝わりません。
  
うまいとか、まずいではなく
このような結果になってます。
というような説明をしましょう。
  
もう一つ大事なこと
  
ステップ実行すを使うと、
 今回の場合は、原因が一発で分かると思います。

投稿日時: 19/07/26 22:58:59
投稿者: vicky_T

 simple 様
 
 解決いたしました。
 アドバイスありがとうございました。