VBA 以下のマクロがどうしても作れない

以下のマクロ④がどうしても作れないので、ご教示頂けると幸いです。


'①選択したファイルを“E:\コスモス2006リンクフォルダ\体温表\2016\※バグあり分”に移動させる。ただし2016は現在の年とする。
'②“E:\コスモス2006リンクフォルダ\体温表\2016\※原本\新体温表色あり”をコピーし、選択したファイルが置いてあったフォルダ内に貼り付け、選択したファイル名と同一に名前にリネームする。
'③選択して移動させたファイルの名前に、右記を追記＆リネームする。“バグあり＿日時”
'ーーーーーーーーーここのマクロをつくってほしいーーーーーーーーー
'④双方を開いて、各シートのテキストをコピー/ペースト、終了とする。
'ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

※具体的なマクロはテキストをアップしています。
　http://1drv.ms/1Qliz8O

何卒よろしくお願いします。（Excel2010です）

No.9 ベストアンサー 回答者： xMAKISHIx 回答日時： 2016/02/12 18:01

ごめんなさい。

処理の説明をすべきでしたね(^_^;)
あとわざわざCallする必要はないです。プロシージャ名を変更して貰えれば大丈夫です。

で本題なんですがなんでエラーが出ているかというと
「.Range("B3:D4") = BugWs.Range("B3:D4")．．．以下略」を12回書いているからです。
以前お見せしてもらったコードではわざわざ12ヶ月分の処理を書いていたので
For lngWsMonth = 1 To 12　から　Next lngWsMonthで12ヶ月分の処理をする様に変更してあります。
なので「.Range("B3:D4") = BugWs.Range("B3:D4")」の部分は以前の1ヶ月分のみで問題ありません。

No.8 回答者： xMAKISHIx 回答日時： 2016/02/10 10:54

Option Explicit

Private Const strFixedPath As String = "E:\コスモス2006リンクフォルダ\体温表\"
Private Const strNewWbPath As String = "\※原本\新体温表色あり.xlsm"

Private Sub Test()
　　
　　With Application
　　　　.EnableEvents = False
　　　　.ScreenUpdating = False
　　　　.Calculation = xlCalculationManual
　　End With
　　
　　Dim lngCheck As Long
　　
　　lngCheck = MsgBox("他のExcelを開いている場合は起動できません。" & vbCrLf & "他のExcelは全て閉じていますか?", vbYesNo + vbQuestion, "バグ差し替え")
　　
　　If lngCheck = vbYes Then
　　　　
　　　　If Workbooks.Count > 1 Then
　　　　　　MsgBox "他のExcelが開いています。"
　　　　　　GoTo ExitProc
　　　　End If
　　　　
　　　　ChDrive "E"
　　　　ChDir strFixedPath & Year(Now) & "\"
　　　　
　　　　Dim vntOpenFileName As Variant
　　　　
　　　　vntOpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xlsm")
　　　　
　　　　If VarType(vntOpenFileName) = vbBoolean Then
　　　　　　MsgBox "キャンセルしました"
　　　　　　GoTo ExitProc
　　　　End If
　　　　
　　　　Dim strBugWbNm As String
　　　　
　　　　strBugWbNm = Dir(vntOpenFileName)
　　　　strBugWbNm = Replace(strBugWbNm, ".xlsm", "_バグあり(" & Format(Now(), "yyyymmdd-hhmmss") & ").xlsm")
　　　　
　　　　Name vntOpenFileName As strFixedPath & Year(Now) & "\" & "※バグあり分\" & strBugWbNm
　　　　
　　　　FileCopy strFixedPath & "※原本\新体温表色あり.xlsm", vntOpenFileName
　　　　
　　　　Dim BugWb As Workbook
　　　　Dim BugWs As Worksheet
　　　　Dim NewWb As Workbook
　　　　Dim NewWs As Worksheet
　　　　Dim lngWsMonth
　　　　
　　　　Set BugWb = Workbooks.Open(strFixedPath & Year(Now) & "\" & "※バグあり分\" & strBugWbNm)
　　　　Set NewWb = Workbooks.Open(vntOpenFileName)
　　　　
　　　　For lngWsMonth = 1 To 12
　　　　　　
　　　　　　Set BugWs = BugWb.Sheets(StrConv(lngWsMonth, vbWide) & "月")
　　　　　　Set NewWs = NewWb.Sheets(StrConv(lngWsMonth, vbWide) & "月")
　　　　　　
　　　　　　BugWs.Unprotect
　　　　　　NewWs.Unprotect
　　　　　　
　　　　　　With NewWs
　　　　　　　　
　　　　　　　　.Range("B3:D4") = BugWs.Range("B3:D4")
　　　　　　　　.Range("E3:J4") = BugWs.Range("E3:J4")
　　　　　　　　.Range("K3:N4") = BugWs.Range("K3:L4")
　　　　　　　　　　　　　　　　　　・
　　　　　　　　　　　　　　　　　　・
　　　　　　　　　　　　　　　　　　・
　　　　　　　　.Range("AO98:AO105") = BugWs.Range("AO98:AO105")
　　　　　　　　.Range("AP98:AQ105") = BugWs.Range("AP98:AQ98")
　　　　　　　　
　　　　　　End With
　　　　　　
　　　　　　Set BugWs = Nothing
　　　　　　Set NewWs = Nothing
　　　　　　
　　　　Next lngWsMonth
　　　　
　　　　BugWb.Close SaveChanges:=False
　　　　NewWb.Close SaveChanges:=True
　　　　
　　　　MsgBox "処理が終わったお"
　　　　
　　End If
　　
ExitProc:
　　
　　With Application
　　　　.EnableEvents = True
　　　　.ScreenUpdating = True
　　　　.Calculation = xlCalculationManual
　　End With
　　
End Sub

こんな感じでどうでしょうか？

この回答へのお礼

せっかくですが、コンパイルエラー：プロージャが大きすぎます、とエラーが出てしまいます。また、教えて頂けると幸いです。以下長すぎるマクロです。http://1drv.ms/1TWePjL

お礼日時：2016/02/12 17:30

No.7 回答者： xMAKISHIx 回答日時： 2016/02/10 09:41

一応出来たのですが文字が文字数オーバーで回答できないのですがどうしますか？

No.6 回答者： xMAKISHIx 回答日時： 2016/02/10 08:47

これデータを移動させる範囲が結構広いですがシートコピーだといけない感じですかね？

No.5 回答者： xMAKISHIx 回答日時： 2016/02/09 10:36

ごめんなさい。

勘違いしてました

No.4 回答者： xMAKISHIx 回答日時： 2016/02/09 10:29

あ、いやそうゆうことではなくてここ範囲被ってますよね？

n1.Range("Q2:V2") = b1.Range("Q2:V2")
n1.Range("P3:V4") = b1.Range("P3:V4")

No.3 回答者： xMAKISHIx 回答日時： 2016/02/09 09:40

コード見させて頂いたんですけどこれコピーしている所で範囲がかぶっているのはなんでなんですか？

この回答へのお礼

ご回答ありがとうございます。バグのある体温表と原本のシートの構造が同じである為です。

お礼日時：2016/02/09 10:21

No.2 回答者： ママチャリ 回答日時： 2016/02/08 21:16

①「選択した」ファイル → 「バグある分」フォルダにリネームして移動

②「原本」ファイル → 「選択した」ファイルへ複写
ここまでは、できているのですよね？

作って欲しいのは、「バグある分」ファイルの中身（シート）をコピーして、
「選択した」ファイル（中身は原本）にペーストということですか？
であれば、①を「移動」ではなく、「複写」にすればよいのでは？

しかし、相変わらず、「作って」なのですね。頑張って勉強しましょう！！

No.1 回答者： xMAKISHIx 回答日時： 2016/02/08 16:07

すみません。

いまいち何がしたいのかがよくわからないのですが流れをもう少し詳しく教えていただいてもいいでしょうか？

この回答へのお礼

お答えいたします。私はこのマクロでバグのある体温表を原本と入れ替えたいと思っています。データも引き継ぎたいのですがそれに難儀しています。

お礼日時：2016/02/08 19:59