おつかれさまです。

EXCEL超初心者マクロ(2)-EXCELファイル取込み-

2018年3月29日

EXCELファイル取込みとタイトル付けしてますが、手で実行するコピーです。
マスタexcelを取込んだりするときにマクロ化しておくと便利です。
サンプルを作ってみましたので参考にしてください。

メインEXCEL: Sample_2.xlsm
取込むEXCEL: Sample_2e.xlsx


赤字を変更してください
青字は、変数ですので宣言を忘れないでください。
※標準モジュールのmudule1の上のほう、Option Explicitに書きます。
前のブログで\簡単に説明しています。

    MSG_FLG = MsgBox("SAMPLE2.xlsx → myEXCEL 取込" & vbCrLf & " 実行OK? ", vbYesNo)
    If MSG_FLG = vbNo Then
       Exit Sub
    End If
   
    mySheetName001 = "SAMPLEEXCEL" '取込みシート名
'  ***クリア処理***
   '### シートフィルタ解除サブプロシジー ###
    sheet_clear
    
'### シートクリア ###
    Sheets(mySheetName001).Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    
    Sheets(mySheetName001).Select
    Range("A1").Select

'############################################################
    
    Const cnsTITLE = "SAMPLE2.xlsx 取込み(*.Xlsx)処理"
    Const cnsFILTER = "SAMPLE2.xlsx (*.Xlsx),*.Xlsx"

    With CreateObject("WScript.Shell")
        .CurrentDirectory = Worksheets("KANRI").Range("B2") '@@ シート設定
    End With
    
    vFILENAME = Application.GetOpenFilename(FileFilter:=cnsFILTER, title:=cnsTITLE)
    If VarType(vFILENAME) = vbBoolean Then
       MsgBox ("キャンセル")
       Exit Sub
    End If

    Set writeSheet = ThisWorkbook.Worksheets(mySheetName001) ' 自分Sheet名 セット
    
    Set strBookName = Workbooks.Open(vFILENAME) '相手オープン

'  ### フィルタを念のため外す
    Sheets("Sheet1").Select
    If Sheets("Sheet1").AutoFilterMode Then
       Sheets("Sheet1").Range("A1").AutoFilter
    End If
    
    Cells.Select
    Selection.Copy
    
    writeSheet.Activate
    Cells.Select
    ActiveSheet.Select
    Range("A1").PasteSpecial
'    Range("A1").PasteSpecial Paste:=xlPasteValues '### 値のみ貼り付け

' 相手クローズ時 クリップモードメッセージと保存しますかメッセージを回避。
    Application.CutCopyMode = False
    Application.DisplayAlerts = False
    strBookName.Close savechanges:=False
    Application.DisplayAlerts = True
    
    writeSheet.Activate '元選択(download)
 
    Set writeSheet = Nothing
    Set strBookName = Nothing
    
'  シートグループ化解除(EXCELグループ化解除必要時)
'    ActiveSheet.Cells.ClearOutline
    
    MsgBox (" SAMPLE2.xlsx 取込み終了 ")
    Range("A1").Select


がんばりましょう。