No.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
No.2
- 回答日時:
#1の補足
Dドライブが、Removal 形式の場合、
最後の方の行で、、
End With
ChDrive "C:\" '←これを入れたほうが安全かもしれません。
Exit Sub
ErrorHandler:
No.1
- 回答日時:
こんにちは。
・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ドライブからマクロは実行します。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) 複数のブックをひとつのブック(複数のシートにまとめる)場合にシートとの順番について 5 2022/12/28 20:47
- Visual Basic(VBA) vbaについて 主に以下のような設定をしたいです。 Aブックの表の行数が20未満だったら Bブックの 1 2023/06/08 23:40
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/05/24 08:33
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
- Visual Basic(VBA) シートをコピーする下記記述でダイアログを用いた記述がわかりません?( A = Dir(ThisWor 4 2022/08/22 12:26
- Excel(エクセル) 【困っています】VBA 追加処理の記述を教えてください。 1 2022/08/25 22:54
- Visual Basic(VBA) VBA This Workbookモジュールを別ファイルにコピーする方法 1 2022/09/14 01:51
- Visual Basic(VBA) マクロVBA 1シートをまとめる 閉じ方 初心者 SOS! 1 2022/06/17 14:54
- Excel(エクセル) 複数のExcelブックのシート1の内容を1つのExcelブックにコピー貼り付けたいのでvbaコードを 7 2023/02/10 23:20
- Visual Basic(VBA) VBA 検索と入力 Excel ブック ぶぶぶ シート ししし 列V 検索対象の列です 最終行は、お 6 2023/05/17 01:40
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
ひとつのファイルを一括で複数...
-
複数のフォルダへ同時にファイ...
-
VBAマクロ 実行時エラーが出た...
-
DOSコマンドでファイルをコピー...
-
XCOPYで指定したフォルダとファ...
-
パソコン、ワンドライブをプリ...
-
Windows10 で登録した外字を他...
-
特定の拡張子だけディレクトリ...
-
コピー先フォルダの更新日時を...
-
フォルダの日付を変更せずにコ...
-
SDカードをパソコンに落とす...
-
ファイルコピーせずフォルダの...
-
電話帳データをコピーしたいです
-
Windows10使用中。「同名ファイ...
-
USBメモリからのコピー
-
外付HDDにフォルダーが作れず、...
-
robocopyでフォルダ自体のコピ...
-
コマンドプロンプトでのxcopyコ...
-
ファイルをコピーするとエラー...
-
大容量ファイルをネットワーク...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ひとつのファイルを一括で複数...
-
複数のフォルダへ同時にファイ...
-
DOSコマンドでファイルをコピー...
-
XCOPYで指定したフォルダとファ...
-
Windows10 で登録した外字を他...
-
SDカードをパソコンに落とす...
-
ファイルコピーに時間がかかります
-
VBAマクロ 実行時エラーが出た...
-
パソコン、ワンドライブをプリ...
-
ファイルのコピー正常終了を確...
-
robocopyでフォルダ自体のコピ...
-
ファイル 「送る」と「コピー...
-
OneDriveの容量がいっぱいにな...
-
ROBOCOPYで移行元と先でサイズ...
-
ファイルコピーせずフォルダの...
-
DVD-RAMからDVD-Rにコピーする...
-
エクセルに添付された画像をフ...
-
VBAでネットワークコンピュータ...
-
外付HDDにフォルダーが作れず、...
-
Windows10 正しくファイルコピ...
おすすめ情報