| 
    
     |  | YN63さん、こんばんは 
 >ありがとうございます。きっちりと動作しました。
 動作して何よりです。
 
 文章が思いっきり苦手なので、うまく説明できませんが
 最初のコードのコメントを付けて見ます。
 
 ご自分で一度必ずHelpや書籍等で確認してくださいね^^;
 
 Sub 順次選択貼付け()
 
 Dim r As Range
 Dim myr As Range
 Dim dteDate As Date
 
 With Sheets("集計表")
 '日付の入力のある範囲をセット
 Set myr = .Range("A4", .Range("A65536").End(xlUp))
 '日付を変数に格納
 dteDate = .Range("A1").Value
 End With
 
 '日付の入力のある範囲を1セルづつ繰り返し変数rにセットする
 For Each r In myr
 '営業所名がNullでない場合実行
 If r.Offset(, 1).Value <> "" Then
 '転記先のシート名が=営業所名なので日付の1列右のセルの値を
 'シート名として指定
 With Sheets(r.Offset(, 1).Value)
 '指定シートのA列最終行+1に日付を転記
 .Range("A65536").End(xlUp).Offset(1).Value = dteDate
 '指定シートのC列最終行+1に売上高を転記
 .Range("C65536").End(xlUp).Offset(1).Value = r.Offset(, 2).value
 End With
 End If
 Next
 
 End Sub
 
 |  |