Excelマクロデータが上書きされてしまう

Question

お世話になります。
先日、こちらで教えて頂いたプログラムの改良のご相談です。

プログラムはこちらです。
　↓
Option Explicit
Public Sub 転送()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim hizuke As Variant
Dim yyyy As Long
Dim mm As Long
Dim dd As Long
Dim sheet_name As String
Dim sheet_name2 As String
Dim row As Long
Dim col As Long
Set sh1 = Worksheets("入力")
'日付取得
hizuke = sh1.Cells(2, "C").Value
'日付から年月日を別々に取得
yyyy = Year(hizuke)
mm = Month(hizuke)
dd = Day(hizuke)
'シート名作成
sheet_name = (yyyy Mod 1000) & "-" & mm & "月"
If CheckSheetName(sheet_name) = False Then
MsgBox ("シート:" & sheet_name & "なし")
Exit Sub
End If
Set sh2 = Worksheets(sheet_name)
'日付に対応するカラム位置及び累計のカラム位置計算
col = 3 + dd
'3行から10行まで繰り返す
For row = 3 To 16
'残業転送
sh2.Cells(row + 1, col).Value = sh1.Cells(row, "C").Value
Next
For row = 3 To 17

'累計転送
sh1.Cells(row - 1, "D").Value = sh2.Cells(row, "C").Value
Next
MsgBox ("転送完了")
End Sub

Private Function CheckSheetName(ByVal sheet_name As String) As Boolean
Dim i As Long
CheckSheetName = True
For i = 1 To Worksheets.Count
If Worksheets(i).Name = sheet_name Then Exit Function
Next
CheckSheetName = False
End Function

■ご相談
過去のデータを後から上書きしたい時、1名だけ時間を入れて転送させると、
その日の全員分のデータが上書きされてしまい、他のメンバーが消えてしまいます。

新たに入力した分だけを上書きするようにできませんでしょうか？

見えづらい画像を貼りますが、不明な点などありましたらご連絡ください。
お手数かけますが、よろしくお願いします。

tatsu99 · Accepted Answer

変更点は
１）入力シートが３～１７行、月別シートが４行～１８行になった。
と理解しました。

以下のようにしてください。
---------------------------------
    '3行から10行まで繰り返す
    For row = 3 To 17
        If sh1.Cells(row, "C").Value <> "" Then
            '残業転送
            sh2.Cells(row + 1, col).Value = sh1.Cells(row, "C").Value
            '累計転送
            sh1.Cells(row, "D").Value = sh2.Cells(row + 1, "C").Value
        End If
    Next
-----------------------------------
    '3行から10行まで繰り返す　・・・は
    '3行から17行まで繰り返す　・・・が正しいですが、修正個所をわかりやすくするために、そのままにしています。

tatsu99 · Answer

No1です。
よくみると、私が回答したものと変わっていますね。
ですので、No1は無視してください。

補足要求です。
１）変える理由がなにかあったのでしょうか。
２）残業転送が３から１６行(for row = 3 to 16)で、累計転送が３から１７行(for row = 3 to 17)だと、累計転送が1行多くなりますが、
それは、意図したものしょうか。

tatsu99 · Answer

前回、回答者です。
以下の部分を変えてください。

'3行から10行まで繰り返す
    For row = 3 To 10
        If sh1.Cells(row, "C").Value <> "" Then '・・・・・追加①
            '残業転送
            sh2.Cells(row, col).Value = sh1.Cells(row, "C").Value
            '累計転送
            sh1.Cells(row, "D").Value = sh2.Cells(row, "C").Value
        End If '・・・・追加②
    Next

追加①、追加②を追加します。

Excelマクロ データが上書きされてしまう

変更点は

No1です。

前回、回答者です。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

Excelマクロデータが上書きされてしまう