dポイントプレゼントキャンペーン実施中!

Cドライブに格納されているブックのシート1のA列の内容を、Dドライブに格納されているブックのシート1のA列にコピーする場合、やはりブック名が分からなければ、ソースを書く事は不可能でしょうか。可能であれば教えていただけませんでしょうか。

※Cドライブのフォルダ名は常に変わらず、その中には一つしかブックは入っていない。

よろしくお願いします。

A 回答 (3件)

こんばんは。



#1の補足、了解しました。
ドライブを逆にすればよいのですね。

もう少し、すっきりしたコードにしてあげられればよいのですが、どちらか片方のファイルが開いていた場合や、コピー先のファイルがない場合などの思い当たるエラーをいくつか考慮してみました。
コードをややこしくしているのはあくまでも、エラーの発生を減らすためです。

ひとつだけ、エラー処理を施していないのは、ありえないようで、あることですが、コピー元とコピー先が同名ファイルの時があります。システムのエラーメッセージが出るはずです。

なお、読みにくいようでしたら、DST とか、SRCとかは、それぞれ、"コピー先"、"コピー元"と、文字列を置換してしまうと、少しは読みやすくなります。

なお、このような例も考えてみました。
 '1列ずつ、左の列から貼り付けていく場合
   'DstSht.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial 'ペースト


'//
Sub Open_CopyR()
 Const SRCDRV As String = "C:\" '検索先ドライブ
 Const SRCFOLD As String = "C:\Users\(YourName)\My Documents\(TestFoler)\" '末尾に\ を入れてください
 Const DSTFILE As String = "Test1.xlsx" 'コピー先ファイル名 *このマクロファイルと同じ場所
 Dim fName As String
 Dim SrcBook As Workbook 'コピー元
 Dim DstBook As Workbook 'コピー先
 Dim DstSht As Worksheet 'コピー先シート
 
 On Error Resume Next
   Set DstBook = Workbooks(DSTFILE) 'すでに開いている場合
 If Err.Number > 0 Then '開いていない場合
  If Dir(DSTFILE) = "" Then MsgBox DSTFILE & " がありません。", vbCritical: Exit Sub
  Set DstBook = Workbooks.Open(ThisWorkbook.Path & "\" & DSTFILE) 'コピー先を開く
 End If
 Set DstSht = DstBook.Worksheets("Sheet1") 'コピー先のシート
 ChDrive SRCDRV 'ドライブ変更 C:\ドライブ
 ChDir SRCFOLD 'フォルダーを開く
 fName = Application.GetOpenFilename("EXCELファイル,*.xl*") 'ファイル名取得
 If MsgBox("'" & fName & "' でよろしいですか?", vbOKCancel, "ファイルオープン") = vbCancel Then Exit Sub
  Set SrcBook = Workbooks(fName) 'すでに開いている場合
 If Err.Number > 0 Then '開いていない場合
   Set SrcBook = Workbooks.Open(fName)
  End If
 If DstSht.Cells(Columns.Count, 1).End(xlToLeft).Column >= Columns.Count Then _
 MsgBox "これ以上コピーできません。", vbCritical: Exit Sub 'A列コピーなら不要
 SrcBook.Worksheets("Sheet1").Columns(1).Copy 'A列をコピー
 DstSht.Range("A1").PasteSpecial 'ペースト
 '1列ずつ、左の列から貼り付けていく場合
   'DstSht.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial 'ペースト
 DstBook.Activate
 DstSht.Range("A1").Select 'ペーストの痕跡を直す
 Application.DisplayAlerts = False 'クリップボードのダイアログを出さない
 SrcBook.Close False 'コピー元を閉じる
 DstBook.Save 'コピー先保存
 DstBook.Close False 'コピー先を閉じる
 Application.DisplayAlerts = True
 Set SrcBook = Nothing
 Set DstSht = Nothing
 Set DstBook = Nothing
 ChDir "D:\" '起動したブックのドライブに戻る
End Sub
    • good
    • 0

#1の補足



Dドライブが、Removal 形式の場合、
最後の方の行で、、

 End With
 ChDrive "C:\" '←これを入れたほうが安全かもしれません。
Exit Sub
ErrorHandler:
    • good
    • 0

こんにちは。



・Cドライブに格納されているブックのシート1のA列の内容を、
・Dドライブに格納されているブックのシート1のA列にコピーする
・Dドライブのブック名は決まっていない

この3つの条件で、Cドライブ側は1つ(一意)であっても、Dドライブ側は変わるという条件でよろしいのでしょうか。

マクロの起動は、別のファイルから、と理解してよろしいのでしょうか?
そうすると、Dドライブ側は、対話型で開くしかないと思います。

ちょっとごちゃごちゃしていますが、ステップモード(F8)で追いかけてみてください。

'//
Sub Open_Copy()
 Const DSTDRV As String = "D:\" 'コピー先ドライブ
 Const SRCFOLD As String = "C:\Users\(YourName)\My Documents\(SpecialName)\" '末尾に\ を入れてください
 Const SRCFILE As String = "Test1.xlsx" 'ソースファイル名
 Dim fName As String
 Dim SrcBook As Workbook
 On Error GoTo ErrorHandler
 On Error Resume Next
 Workbooks(SRCFILE).Activate
 If Err.Number > 0 Then
  Workbooks.Open SRCFOLD & SRCFILE
 End If
 Set SrcBook = ActiveWorkbook
 On Error GoTo 0
 ChDrive DSTDRV 'ドライブ変更
 
 '対話型ダイアログボックス
 fName = Application.GetOpenFilename("EXCELファイル,*.xl*") 'ファイル名取得
 If MsgBox("'" & fName & "' でよろしいですか?", vbOKCancel) = vbCancel Then Exit Sub
 With Workbooks.Open(fName)
  SrcBook.Worksheets("Sheet1").Columns(1).Copy 'A列(縦)をコピー
  .Worksheets("Sheet1").Range("A1").PasteSpecial 'ペースト
  .Worksheets("Sheet1").Range("A1").Select 'ペーストの痕跡を直す
 
  Application.DisplayAlerts = False 'クリップボードのダイアログを出さない
    SrcBook.Close False 'コピー元を閉じる
    .Save
    .Close False
  Application.DisplayAlerts = True
 End With
 Exit Sub
ErrorHandler:
 'ドライブが用意されていない時のエラーメッセージ
 If Err.Number = 68 Then
  MsgBox Err.Description, vbCritical
 End If
End Sub

この回答への補足

>マクロの起動は、別のファイルから、と理解してよろしいのでしょうか?

ご回答、ありがとうございます。

正しくは下記です、本当に申しわけありません。

・Cドライブに格納されているブックのシート1のA列の内容を、
・Dドライブに格納されているブックのシート1のA列にコピーする
・Cドライブのブック名は決まっていない、Dドライブのファイル名は固定です。

さらに、

・Dドライブからマクロは実行します。

補足日時:2013/04/06 15:47
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!