さんぷる２

Sub クエリ転記()
'クエリ転記

Macro

Dim ans As String

'宣言　開始-----------------------------

'転記先パス作成用
Dim path_to1   As String
Dim path_to2 As String
Dim path_to3 As String
Dim path_total As String

'貼り付け数値の整合性をチェック用　※未実装
Dim motosum As Integer
Dim sakisum As Integer

'宣言　終了-----------------------------
  
   

'転記先パスの作成　＠＠＠
path_to1 = Range("b1")

path_to2 = Format(Month(Now()) - 1, "00")
path_to3 = Range("b2")
path_total = path_to1 & "\" path_to2 & "\" & path_to3

'転記先パス確認
ans = MsgBox("【注意】" & Chr(13) & "転記先のパスは、" & Chr(13) & path_total & Chr(13) & "でよろしいでしょうか。", vbYesNo)
If ans = vbYes Then

'貼り付け先のシートを開いていないか。
'閉じている＝続行　閉じていない＝中止
ans = MsgBox("【注意】" & Chr(13) & "転記先のシートは閉じていますか？", vbYesNo)
If ans = vbYes Then

'------------------------------------------------------------------------------------------------------
'★★★★★------【クエリ実行結果　０１.シート：＠**********　の一斉転記　ＳＴＡＲＴ】-----------------
'------------------------------------------------------------------------------------------------------

'★★★【01.＠xxxxx】転記ＳＴＡＲＴ--------------------------------------------------------------------

Sheets("転記元データシート１").Select

'チャネルでフィルタ　＠B4:F4、＠Criteria1　＠T　＠c5

Range("B4:F4").Select
Selection.AutoFilter
ActiveSheet.Range("$B$4:$F$13").AutoFilter Field:=1, Criteria1:="T"

Range("C5").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy

'貼り付け先のエクセルをオープン
Workbooks.Open Filename:=path_total

'【01.xxxxx】の貼り付け  ＠貼り付け先の項目名　　＠エラー内のB4
Sheets("T").Select

If Range("B4") = "＠貼り付け先の項目名" Then
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
MsgBox "エラーのため処理を中断します。" & Chr(13) & "貼り付け先の項目名【" & Range("B4") & "】が、想定している項目名と一致しません。貼り付け先が異なっているか、項目名が変更になっている可能性があります。"
GoTo end999
End If

'☆☆☆【01.＠xxxxx】転記　ＥＮＤ　------------------------------------------------------------------

'★★★【02.＠xxxxx】転記ＳＴＡＲＴ------------------------------------------------------------------

'☆☆☆【02.＠xxxxx】転記　ＥＮＤ　------------------------------------------------------------------

'★★★【03.＠xxxxx】転記ＳＴＡＲＴ------------------------------------------------------------------

'☆☆☆【03.＠xxxxx】転記　ＥＮＤ　----------------------------------------------------------------------

'★★★【04.＠xxxxx】転記ＳＴＡＲＴ----------------------------------------------------------------------

'☆☆☆【04.＠xxxxx】転記　ＥＮＤ　----------------------------------------------------------------------

'★★★【05.＠xxxxx】転記ＳＴＡＲＴ----------------------------------------------------------------------

'☆☆☆【05.＠xxxxx】転記　ＥＮＤ　----------------------------------------------------------------------

'★★★【06.＠xxxxx】転記ＳＴＡＲＴ----------------------------------------------------------------------

'☆☆☆【06.＠xxxxx】転記　ＥＮＤ　----------------------------------------------------------------------

'------------------------------------------------------------------------------------------------------
'☆☆☆☆☆------【クエリ実行結果　０１.シート：＠**********　の一斉転記　　ＥＮＤ　】-----------------
'------------------------------------------------------------------------------------------------------

MsgBox "転記を行いました。転記先のシートを確認してください。" & Chr(13) & "（未保存）"

Else
MsgBox "処理を中断します。" & Chr(13) & "ファイルを閉じてから実行してください。"
End If

Else
MsgBox "処理を中断します。" & Chr(13) & "所定の位置に転記先のパスを記載してから実行してください。"
End If

'終了処理
end999:

Windows("転記元.xlsm").Activate
Sheets("転記元データシート１").Select
Application.CutCopyMode = False

End Sub