[[20181016094236]]　『コピー元のデーターが、コピー先ではなくコピー元』（ロンメル）　ページの最後に飛ぶ

『コピー元のデーターが、コピー先ではなくコピー元に貼り付けられる』（ロンメル）

よろしくお願いします。

日報と月報という帳票があり、日報の合計値か平均値
(合計値がある場合は、合計値、無い場合は平均値)をコピーして、
月報に貼り付けるというマクロを組みました。

作成から今まで約半年程は問題なく動いていましたが、
先月突然、本来月報に貼り付けられるべき1日～5日までの日報データーが、
日報の別セルに貼り付けられ、日報データが書き換えられてしまいました。

1日～5日以外の日報では上記の不具合は発生しておらず、
何が悪いのか皆目見当が付きません。

申し訳有りませんが、ヒントだけでもご教示頂ければ幸いです。

下記、マクロのコードを貼り付けます。

For J = 1 To DayMax '日数カウント最大値(前日)まで処理を実行

        Nippou = "D" + Format(Newdate, "yyyymm") + Format(J, "00") + ".xls" '日報ファイル格納
        Workbooks.Open Pass & Name_nippou(1) & "\" & Nippou  '日報オープン
        DoEvents

        For K = 0 To 19 'コピーする行列数分処理を実行

            Windows(Nippou).Activate 'コピー元(日報)をアクティブにする

            If (Range("B41").Offset(1, K).Text = "-") Then 'コピー先が平均値か合計値かを判別

                If Range("B41").Offset(0, K).Text = "" Or IsError(Range("B41").Offset(0, K)) Then

                    Cell(K, 1) = 1 'コピー先が空欄

                Else

                    Cell(K, 1) = 0 'コピー先が空欄ではない
                    Cell(K, 0) = Range("B41").Offset(0, K).Value '平均値を格納

                End If

            Else

                If Range("B41").Offset(1, K).Text = "" Or IsError(Range("B41").Offset(1, K)) Then

                    Cell(K, 1) = 1 'コピー先が空欄

                Else

                    Cell(K, 1) = 0 'コピー先が空欄ではない
                    Cell(K, 0) = Range("B41").Offset(1, K).Value '合計値を格納

                End If

            End If

        Next

        Application.DisplayAlerts = False '確認メッセージ非表示
        Windows(Nippou).Activate 'コピー先(日報)をアクティブにする
        ActiveWindow.Close 'コピー元(日報)を閉じる
        Application.DisplayAlerts = True  '確認メッセージ表示

        For K = 0 To 19 'コピーする行列数分処理を実行

            If (Len(Range("B14").Offset(0, K)) <> 0) Then 'コピー先が空欄かを判別

                If (Cell(K, 1) = 0) Then 'コピー先が空欄ではない

                    Windows(Geppou).Activate 'コピー先(月報)をアクティブにする
                    Range("B18").Offset(J - 1, K).Value = Cell(K, 0) '数値の貼付け

                Else

                    Windows(Geppou).Activate 'コピー先(月報)をアクティブにする
                    Range("B18").Offset(J - 1, K) = " " '数値の貼付け

                End If

            End If

        Next

        Windows(Geppou).Activate 'コピー先(月報)をアクティブにする
        Application.DisplayAlerts = False '確認メッセージ非表示
        ActiveWorkbook.Save 'コピー先(月報)を保存
        Application.DisplayAlerts = True  '確認メッセージ表示

    Next

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

 そういう時は、F8キーでステップ実行をして自分で確認する習慣をつけましょう。

（BJ） 2018/10/16(火) 11:48

.Activateを使っているから環境や実行した時によって誤動作するのです。

RangeやCellsの前にWorksheetオブジェクトを明示すれば、そのような問題はまず起こりません。
（名無し） 2018/10/16(火) 12:05

名無しさんとかぶったけど、そのまま

部分的にしか提示されていないのでよくわからないですが、少なくとも複数のシート（ブック）が絡んでいるので、Range～、Cells～のように記述してある部分すべてについて、どのシートを指しているのか、明示するように修正したほうがよいでしょうね。

その過程で、「Withステートメント」について調べてみると、すっきりとしたコードにできるとおもいます。

（もこな２） 2018/10/16(火) 12:19

ご回答有難う御座います。

ご助言にそって、コード見直します。

助かりました。
（ロンメル） 2018/10/16(火) 12:59

無理やり整理してみました。

    Sub 無理やり整理()
        Dim J As Long, K As Long, DayMax As Long
        Dim Newdate As Date
        Dim MyPath As String 'フォルダパスの"パス"は「Path」です
        Dim Nippou As String
        Dim Name_nippou As Variant 'なんで配列にしてるのかわからないけど、とりあえず・・

        Dim dstWB As Workbook '←　追加

        '「日数カウント」とは何かわからないが、変数名から妄想
        Newdate = "2016/9/16"
        DayMax = Format(DateSerial(Year(Newdate), Month(Newdate) + 1, 0), "d")

        '前記のとおりなぜ配列なのかよくわからないが・・・
        Name_nippou = Array("フォルダ１", "フォルダ２")
        MyPath = ThisWorkbook.Path & Name_nippou(1) & "\"   '←適宜変更のこと

        For J = 1 To DayMax '日数カウント最大値(前日)まで処理を実行

            '文字列の結合は「&」で！
            With Workbooks.Open(MyPath & "D" & Format(Newdate, "yyyymm") & Format(J, "00") & ".xls")     '日報オープン

            'DoEvents ←何のために入れてるのか不明
                '↓シートを明示するなら（ActiveSheetに頼らないなら）要らない
                'また、どうしても書くにしてもループの外に置くべき
                'Windows(Nippou).Activate
                With .Worksheets(1) '←　シートは適当なので適宜修正のこと

                    For K = 0 To 19 'コピーする行列数分処理を実行
                        If .Range("B41").Offset(1, K).Text = "-" Then 'コピー先が平均値か合計値かを判別
                            If .Range("B41").Offset(0, K).Text = "" Or IsError(.Range("B41").Offset(0, K)) Then
                                .Cell(K, 1) = 1 'コピー先が空欄
                            Else
                                .Cell(K, 1) = 0 'コピー先が空欄ではない
                                .Cell(K, 0) = .Range("B41").Offset(0, K).Value '平均値を格納
                            End If
                        Else
                            If .Range("B41").Offset(1, K).Text = "" Or IsError(.Range("B41").Offset(1, K)) Then
                                .Cell(K, 1) = 1 'コピー先が空欄
                            Else
                                .Cell(K, 1) = 0 'コピー先が空欄ではない
                                .Cell(K, 0) = .Range("B41").Offset(1, K).Value '合計値を格納
                            End If
                        End If
                    Next
                End With

                .Save '日報ブックを上書き保存（元コードにはないが、日報ブック内を書き換えてるから保存せずに閉じたら意味が無い）
                .Close '日報ブックを閉じる（直前に保存処理してるから確認メッセージはそもそも出ないハズ）
            End With

            '同じ話だが唐突に月報ブックを操作してるので、その辺もちゃんと明示（修飾）すべき
            '日報ブックを閉じたあと、何がActiveになっているつもりだったのかわからないけど
            '月報ブックにこのマクロが書いてあるとして・・・
            With ThisWorkbook.Worksheets(1)
                For K = 0 To 19 'コピーする行列数分処理を実行
                    If (Len(.Range("B14").Offset(0, K)) <> 0) Then 'コピー先が空欄かを判別
                        If (.Cell(K, 1) = 0) Then 'コピー先が空欄ではない
                            .Range("B18").Offset(J - 1, K).Value = Cell(K, 0) '数値の貼付け
                        Else
                            .Range("B18").Offset(J - 1, K) = " " '数値の貼付け
                        End If
                    End If
                Next

                '月報ブックを初めて保存するのではないのだろうから、
                '「DisplayAlerts」を制御する必要がなさそうな気がするのは私だけ？
                Application.DisplayAlerts = False '確認メッセージ非表示
                ActiveWorkbook.Save 'コピー先(月報)を保存
                Application.DisplayAlerts = True  '確認メッセージ表示
            End With
        Next

    End Sub

こんな感じで、提示のコードだと、同じシート内でコピペするようになっているので、
日報を月報に集約するマクロのイメージであれば、根本的に見直す必要がありそうな気がします。

（もこな２） 2018/10/17(水) 04:18

コメント返信：

[ 一覧(最新更新順) ]

[[20181016094236]] 『コピー元のデーターが、コピー先ではなくコピー元』（ロンメル） ページの最後に飛ぶ

[[20181016094236]]　『コピー元のデーターが、コピー先ではなくコピー元』（ロンメル）　ページの最後に飛ぶ