@YUA0302

Are you sure you want to delete the question?

Leaving a resolved question undeleted may help others!

VBA コピーペースト

VBAコピー ペースト 

ファイル(売上.xls)を別ファイルからコピーしたいです
csvでなくxlsファイルの取込となります。


日付,商店名,商品名,個数
5/1,A,りんご,2
5/2,A,みかん,1
5/3,B,りんご,1
5/4,Bりんご,4
5/5,C,りんご,4
5/6,A,みかん,3



エクスプローラーを開いて、別ブックにある売上.xlsを丸ごとコピー
ファイルは1つだけ読み込む想定です。

自分で進めてみましたが、ペーストの仕方に問題があるみたいでエラーが解消されてません。下記を元に作成頂いてもかまいませんし、全く別の書き方でも問題ありません。

Sub データ()
    Dim openpath As Variant     '開いたブックのパス 変数
    Dim mysheet As Worksheet    'マクロのシート 変数
    Dim bhairetu As Variant     'ブックの配列 変数
    Dim copybook As Workbook    'コピー元のワークブック 変数
    Dim LstRow2 As Long         '最終行の取得
    'マクロ(コピー先)のシートを格納
    Set mysheet = ThisWorkbook.Worksheets("一覧")


    Application.ScreenUpdating = False  '画面の描画抑制

    'On Error GoTo myError       'ここでエラーが発生するとmyErrorにジャンプ
    'ダイアログボックスを表示 パスを代入
    openpath = Application.GetOpenFilename("Excel ブック,*.xls?", , , MultiSelect:=True)

            Set copybook = ThisWorkbook     '開いたブックをcopybookに代入

            '元々入っているデータを削除
            mysheet.Activate
            Range("A3:K3").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.ClearContents


            '範囲指定した表をコピー
            copybook.Copy


            '貼り付け
            mysheet.Paste

            Application.CutCopyMode = False     'コピーモードをとめる


            Application.DisplayAlerts = False   'アラートをとめる
            copybook.Close                      'コピー元ブックを閉じる
            Application.DisplayAlerts = True    'アラートを出す

            Application.ScreenUpdating = True   '画面の描画開始


'myError:                'この行にジャンプ
    'MsgBox ("ご指定のブックに" & vbCrLf & "処理できないデータが入っています")
    copybook.Close
End Sub

以上、よろしくお願いします!!

0 likes

1Answer

Sub データ()

    Dim openPath As Variant     '開いたブックのパス 変数
    Dim mySheet As Worksheet    'マクロのシート 変数
    Dim arrBook As Variant     'ブックの配列 変数
    Dim copyBook As Workbook    'コピー元のワークブック 変数
    Dim lastRow As Long         '最終行の取得

    'マクロ(コピー先)のシートを格納
    Set mySheet = ThisWorkbook.Worksheets("一覧")

    Application.ScreenUpdating = False  '画面の描画抑制

    'On Error GoTo myError       'ここでエラーが発生するとmyErrorにジャンプ

    'ダイアログボックスを表示 パスを代入 複数選択不可
    openPath = Application.GetOpenFilename("Excel ブック,*.xls?")


    '****追記****

    'キャンセルすると、変数openPathにFalseが返ってきます。
    'ですので、openPathがBoolean型か?を判定します。
    'キャンセルされたら先に進めないので、処理を中断します。
    If VarType(openPath) = vbBoolean Then
        MsgBox "処理を中断します"
        Exit Sub
    End If

    '**********


    'ThisWorkbookはマクロを実行しているブックです
    '開いたブックではありません
    'Set copybook = ThisWorkbook     '開いたブックをcopybookに代入

    '開いたブックを変数に代入
    Set copyBook = Workbooks.Open(openPath)

    With mySheet

        '元々入っているデータを削除
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range( .Cells(3, 1), .Cells(lastRow, 11)).ClearContents

        '開いたブックの1枚目のシートのA1セルを含む範囲をコピー
        'コピー先シートのA3セルに貼り付け
        'ヘッダを貼り付けたくなければ、別途調整が必要です
        copyBook.Worksheets(1).Range("A1").CurrentRegion.Copy .Range("A3")

    End With

    Application.DisplayAlerts = False   'アラートをとめる
    copyBook.Close                      'コピー元ブックを閉じる
    Application.DisplayAlerts = True    'アラートを出す

    Application.ScreenUpdating = True   '画面の描画開始

'myError:                'この行にジャンプ
    'MsgBox ("ご指定のブックに" & vbCrLf & "処理できないデータが入っています")
    'copybook.Close
End Sub

テストしていないのでうまくいかなかったらすみません。
また、部分的な回答ですみません。

0Like

Comments

  1. @YUA0302

    Questioner

    ありがとうございます!稼働しました!
    エクスプローラーを開いて、キャンセルした場合の処理はどのように書くのでしょうか…?><
  2. キャンセル処理を追記しました。
    うまくいくといいのですが・・・。
  3. @YUA0302

    Questioner

    ありがとうございます!うまくいきました!

Your answer might help someone💌