- ベストアンサー
ExcelVBA別フォルダにあるブックのコピー方法
- ExcelVBAでデータを条件に応じて別フォルダにコピーする方法について
- VBAファイル.xlsと複数のフォルダおよびファイルがあり、特定の条件でデータをコピーする処理について
- ファイルC_結果.xlsにコピーするデータの作成手順と、ファイル名の変更に関する要望
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
#1、cjです。 補足欄への返答です。 > 最後にファイル名を付けるときに、コンボボックスで選択した年を先頭として(この場合では)【2007_ファイルC.xls】としたい........ ' ' "ファイルC_2006~2008年結果.xls"形式の名前を付け保存して閉じる sht結果.Parent.Close SaveChanges:=True, Filename:=sMyDir & "3_フォルダC\ファイルC_" & Label1.Caption & "結果.xls" ' ● の部分を以下のように差し替えてみてください。 ' ' "ファイルC_2006~2008年結果.xls"形式の名前を付け保存して閉じる sht結果.Parent.Close SaveChanges:=True, Filename:=sMyDir & ComboBox1.Value & "_ファイルC.xls" ' ● 返答、以上です。
その他の回答 (2)
- cj_mover
- ベストアンサー率76% (292/381)
#1、2、cjです。 #2に追記です。 設問が詳しくないので迷いますが、 やはり、「3_フォルダC」に保存する、ということでしたら、 ' ' "ファイルC_2006~2008年結果.xls"形式の名前を付け保存して閉じる sht結果.Parent.Close SaveChanges:=True, Filename:=sMyDir & "3_フォルダC\" & ComboBox1.Value & "_ファイルC.xls" ' ● という風になります。 追記、以上です。
お礼
丁寧に回答下さいましてありがとうございました。本当に助かりました。
- cj_mover
- ベストアンサー率76% (292/381)
' ' ●サブフォルダ名 ' ' ●ブック名 ' ' ●シート名 ' ' ●セル番地 ' ' ●ActiveXコントロールのオブジェクト名 ' ' ●ファイルが存在する年次期間 ' ' ●作成したブックの新しい名前 ' ' 相違無いか要確認、適宜修正。 Private Sub CommandButton1_Click() ' ● Dim vTgYear As Variant Dim sht結果 As Worksheet Dim sht元データ As Worksheet Dim sMyDir As String Dim sWbkFullName As String Dim sShtName As String Dim sMsg As String Dim i As Long vTgYear = ComboBox1.Value ' ● If Not vTgYear Like "####" Then MsgBox "年次を指定してからやり直し", vbExclamation Exit Sub End If Select Case vTgYear Case 1999 To 2012 ' ● Case Else MsgBox "1999~2012の間で年次を指定してからやり直し", vbExclamation ' ● Exit Sub End Select sMyDir = ThisWorkbook.Path & "\" With Application .ScreenUpdating = False ' .DisplayAlerts = False .Calculation = xlCalculationManual End With ' ' ファイルC_結果.xls を開く sWbkFullName = sMyDir & "3_フォルダC\ファイルC_結果.xls" ' ● sShtName = "Sheet1" ' ● On Error Resume Next Set sht結果 = Workbooks.Open(sWbkFullName).Sheets(sShtName) On Error GoTo 0 If sht結果 Is Nothing Then MsgBox sWbkFullName & vbLf & sShtName & vbLf & "開くことが出来ませんでした", vbExclamation Exit Sub End If ' ' 出力先のセル範囲を値消去 sht結果.Range("D7:F25,H7:J25").ClearContents ' ● ' ' 前年~翌年、ループ For i = -1 To 1 ' ' 1_フォルダA sWbkFullName = sMyDir & "1_フォルダA\" & vTgYear + i & "_ファイルA.xls" ' ● sShtName = "Sheet1" ' ● On Error Resume Next Set sht元データ = Workbooks.Open(sWbkFullName).Sheets(sShtName) On Error GoTo 0 If sht元データ Is Nothing Then sMsg = sMsg & vbLf & "●" & sWbkFullName & vbLf & sShtName Else sht結果.Range("E7:E25").Offset(, i).Value = sht元データ.Range("C7:C25").Value ' ● sht元データ.Parent.Close SaveChanges:=False Set sht元データ = Nothing End If ' ' 2_フォルダB sWbkFullName = sMyDir & "2_フォルダB\" & vTgYear + i & "_ファイルB.xls" ' ● sShtName = "Sheet1" ' ● On Error Resume Next Set sht元データ = Workbooks.Open(sWbkFullName).Sheets(sShtName) On Error GoTo 0 If sht元データ Is Nothing Then sMsg = sMsg & vbLf & "●" & sWbkFullName & vbLf & sShtName Else sht結果.Range("I7:I25").Offset(, i).Value = sht元データ.Range("C6:C24").Value ' ● sht元データ.Parent.Close SaveChanges:=False Set sht元データ = Nothing End If Next i ' ' "ファイルC_2006~2008年結果.xls"形式の名前を付け保存して閉じる sht結果.Parent.Close SaveChanges:=True, Filename:=sMyDir & "3_フォルダC\ファイルC_" & Label1.Caption & "結果.xls" ' ● With Application .ScreenUpdating = True ' .DisplayAlerts = True .Calculation = xlCalculationAutomatic End With Set sht結果 = Nothing If sMsg = "" Then MsgBox Label1.Caption & vbLf & "処理完了", vbInformation Else MsgBox sMsg & vbLf & "開くことが出来ませんでした", vbExclamation End If End Sub
補足
遅くなりまして申し訳ありません。いろいろ試していたらお礼が遅くなってしまいました。カテゴリー別にデータが複数行にわたっているのでいろいろやっているのですが、一つだけ解決できないことができないのでよろしければ教えてください。最後にファイル名を付けるときに、コンボボックスで選択した年を先頭として(この場合では)【2007_ファイルC.xls】としたいのですがどうしてもうまくできません。どうしたら解決するかご教授いただけますと幸いです。よろしくお願い致します。
お礼
ありがとうございました!できました!本当にありがとうございます!