[[20140716135040]]　『最終行の下に値のみ貼り付ける』（涼夏）　ページの最後に飛ぶ

『最終行の下に値のみ貼り付ける』（涼夏）

 別ファイルにあるデータを下のファイルの最終行の次に値のみ貼り付けるには？
 日々、別ファイルのデータの貼り付け作業をしています。
 フォントサイズやカラーや背景が施してあるので値だけ貼り付けています。
 さらに下のファイルにも条件付書式を設定しているのです。

 D：Gの最終行の次に値のみ貼り付ける方法がありましたら教えてください。

	A	B	C	D	E	F	G
1	7/9	120		7月1日	プール	ことり	北
2	7/9	121			プール	ことり	北
3	7/9	123		7月8日	サッカーこいぬ	南

 貼り付ける行は毎回決まってません。
 またD列の日付が空白のケースもありますが、そのままE：Gまで値のみ貼り付けたいです。

 A列はいつも貼り付けた後で貼り付けた日を入力していますのでそこも一気に入力できたら
 助かるのですが。

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

 ちょっと事情が呑み込めないのですけど、

 全体の流れは、
 　(1)別のファイル（ソースファイル）のある行をコピーして、
 　(2)下のファイル（ターゲットファイル）の最下段の1行下に値の貼り付けをする
 　(3)そして、A列に貼り付けした日を自動出力する。
 ですよね？

 (3)を自動でやりたいことだけは分かりました。

 それ以外はどこを自動でやりたいのですか？
 もう少し細かく分解してご説明ください。

（半平太） 2014/07/16(水) 16:06

 あっごめんなさい。半平太さん　ありがとうございます。

 ターゲットファイルの最下段を探さなくても　たとえば　Ctrl+Q　で最下段の次から
 ソースファイルのある数行を値のみ貼り付ける．．．みたいな。
 そして貼り付けた数行のA列に貼り付けした日が自動で入力．．．です。

 これを書きながらちょっと欲張った感もありますが、出来ればいいな．．．と。

 よろしくお願いします！！

（涼夏） 2014/07/16(水) 17:14

私には難し過ぎの感がありますので、ドロップアウトします。　^_^;

他の回答者の方、よろしくお願いします。

（半平太） 2014/07/16(水) 20:32

 説明が無い部分は適当に決めてのサンプルです。

 現在表示しているシート（説明中の「別ファイルにあるデータ」）の D:G列のデータを
 マクロを置いたファイルの先頭シート（説明中の「下のファイル」）の下にコピーします。
 タイトル行が1行目で2行目以下がデータ、データ領域外のセルは未使用の想定です。
 Ctrl+Q（はショートカット定義？）はマクロオプションで設定してください。

 Sub Sample()
   '// コピー元シート：表示中のシート
    Dim srcWS As Worksheet
    Set srcWS = ActiveSheet

   '// コピー先シート：マクロブックの先頭シート
    Dim dstWS As Worksheet
    Set dstWS = ThisWorkbook.Worksheets(1)

   '// コピー範囲
    Dim copyRange As Range
    Set copyRange = Intersect(srcWS.Range("D2:G" & Rows.Count), srcWS.Range("D1").CurrentRegion)

    Dim writeRow As Long
    Dim r As Long
    With dstWS
        '// 追記行
        writeRow = Application.Max(.Cells(Rows.Count, "D").End(xlUp).Row, _
            .Cells(Rows.Count, "E").End(xlUp).Row, _
            .Cells(Rows.Count, "F").End(xlUp).Row, _
            .Cells(Rows.Count, "G").End(xlUp).Row) + 1

        '// データの値コピー
        .Cells(writeRow, "D").Resize(copyRange.Rows.Count, copyRange.Columns.Count).Value = copyRange.Value

        '// 今日の日付
        .Cells(writeRow, "A").Resize(copyRange.Rows.Count, 1).Value = Date

        '// 追記した末尾の空白行の削除
        For r = writeRow + copyRange.Rows.Count - 1 To writeRow Step -1
            If Application.CountIf(.Cells(r, "D").Resize(1, 4), "") = 4 Then
                .Rows(r).Delete
            Else
                Exit For
            End If
        Next
    End With
 End Sub
（Mook） 2014/07/16(水) 21:32

こういう感じのことでしょうか？

 汎用性がありません
 コードを理解していないと応用がきかないと思います。

 Sub test()
    Dim Ws As Worksheet
    Dim r As Long

    Set Ws = Workbooks("Book2").Worksheets("Sheet1")
    r = Ws.Range("G" & Rows.Count).End(xlUp).Row

    With Selection.EntireRow.Columns("A:D")
        Ws.Range("D" & r + 1).Resize(.Rows.Count, 4).Value = .Value
        Ws.Range("A" & r + 1).Resize(.Rows.Count).Value = Date
    End With

    Ws.Activate

 End Sub

（マナ） 2014/07/16(水) 21:37

コメント返信：

[ 一覧(最新更新順) ]

[[20140716135040]] 『最終行の下に値のみ貼り付ける』（涼夏） ページの最後に飛ぶ

[[20140716135040]]　『最終行の下に値のみ貼り付ける』（涼夏）　ページの最後に飛ぶ