『データーを一気に転記する方法』（さくら）

以前[[20100710113026]]でご教授いたただきありがとうございます。
 以前は自分の要望により簡単な方法を教えていただきましたが、
 最近データが増え一行ずつ転記する方法ではなく一気に転記できる方法を教えてください。

 値のみ転記する場合「Copy 」する方法しかないのですか？

 分かる方教えてください。よろしくお願いします。

 「シート1」
 F1　日付
 A2　番号
 A3　名前
 を

 A8　商品A　数量　金額　
 A9　商品B　数量　金額
 ：
 ：

 「シート2」転記先シート
 日付　番号　名前　商品A　数量　金額
 日付　番号　名前　商品B　数量　金額

 マクロ
  With Sheets("シート2")
       mr = .Range("A" & Rows.Count).End(xlUp).Row + 1
    
    For r = 8 To 22
        If Application.WorksheetFunction.CountA(Worksheets("シート1").Range("A" & r).Resize(1, 6)) = 0 Then Exit For
        .Cells(mr, "A").Value = Range("G2").Value '番号
        .Cells(mr, "B").Value = Range("G1").Value '日付
        .Cells(mr, "C").Value = Range("A2").Value 'TEL番号
        .Cells(mr, "D").Value = Range("A3").Value '社名
        
        '書式のコピー
        .Cells(mr - 1, "A").Resize(1, 13).Copy
        .Cells(mr, "A").Resize(1, 13).PasteSpecial Paste:=xlPasteFormats
       
        
        '値のコピー
         Cells(r, "A").Resize(1, 8).Copy
         .Cells(mr, "E").Resize(1, 8).PasteSpecial
         '.Cells(mr, "E").Resize(1, 8).PasteSpecial Paste:=xlPasteValues
         
        mr = mr + 1
    
    Next
     End With
----
 こんばんわ。。
 提示された図表を元にCOPYを使わずに作ってみました。。

 Sub test()
    Dim i As Long
        
    Sheets("Sheet1").Activate
    i = Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("Sheet2")
        Range(.Cells(1, 1), .Cells(i - 7, 1)).Value = Range("F1").Value
        Range(.Cells(1, 2), .Cells(i - 7, 2)).Value = Range("A2").Value
        Range(.Cells(1, 3), .Cells(i - 7, 3)).Value = Range("A3").Value
        Range(.Cells(1, 4), .Cells(i - 7, 6)).Value = Range(Cells(8, 1), Cells(i, 3)).Value
    End With
 End Sub
 余分な変数宣言を削除しました。22:05 9/1
 (kei)
----
 kei さんありがとうございます。
 頂いたコード実行したところえらー発生しました。「エラー400」
 です。なぜでしょか？

 セルが結合してる場合エラーになりますか？

 （さくら）


----
 Value=Valueの両方のセルの形が同じであればOKですが、じゃないとエラーです。
 転記先のセルの形をデータの形に合わせておく必要があります。。
 (kei)
----
keiさんすみません。
うまく転記できました。ありがとうございます。
 ただ、sheet2の一行から書き足されます。
題名が消されます。
最終行+1にデータ書き足せるように出来ませんか？

i-7はどのセルになりますか？
 お手数ですが、よろしくお願いします。

 さくら
----
 さくらさん、おはよーございます。。
 表題の件OKです。

     With Sheets("Sheet2")
        Range(.Cells(2, 1), .Cells(i - 6, 1)).Value = Range("F1").Value
        Range(.Cells(2, 2), .Cells(i - 6, 2)).Value = Range("A2").Value
        Range(.Cells(2, 3), .Cells(i - 6, 3)).Value = Range("A3").Value
        Range(.Cells(2, 4), .Cells(i - 6, 6)).Value = Range(Cells(8, 1), Cells(i, 3)).Value
    End With
 上記のように、転記先の最初の行を一つ下げて、最後の行を一つ下げます。

 下記のように、Offset(1)を使っても良いです。。
     With Sheets("Sheet2")
        Range(.Cells(1, 1), .Cells(i - 7, 1)).Offset(1).Value = Range("F1").Value
        Range(.Cells(1, 2), .Cells(i - 7, 2)).Offset(1).Value = Range("A2").Value
        Range(.Cells(1, 3), .Cells(i - 7, 3)).Offset(1).Value = Range("A3").Value
        Range(.Cells(1, 4), .Cells(i - 7, 6)).Offset(1).Value = Range(Cells(8, 1), Cells(i, 3)).Value
    End With
 (kei)
----
 keiさんこんにちわ。
 With Sheets("Sheet2")は随時にデータを貯蓄します。

 二回目に転記するとは
 最終行+1にはならないです。何が原因でしょ？？

 keiさんのデータでは2回以降も
 最終行+1にデータ記入されていますか？

 すみません再度お願いします。

 (さくら)
----
 >i = Cells(Rows.Count, 1).End(xlUp).Row
 iがSheet1の最終行です。
 
    With Sheets("Sheet2")
        Range(.Cells(2, 1), .Cells(i - 6, 1)).Value = Range("F1").Value
        Range(.Cells(2, 2), .Cells(i - 6, 2)).Value = Range("A2").Value
        Range(.Cells(2, 3), .Cells(i - 6, 3)).Value = Range("A3").Value
        Range(.Cells(2, 4), .Cells(i - 6, 6)).Value = Range(Cells(8, 1), Cells(i, 3)).Value
    End With
 testで実行すると、Sheet2の結果はどのようになるのですか?
 (kei)
----
 keiさんすみません。

 ＞ iがSheet1の最終行です。
 シートにの最終行もiを使用できますか?

一回目の転記

「シート1」
 F1　日付
 A2　番号
 A3　名前
 を

 A8　商品A　数量　金額　
 A9　商品B　数量　金額
 ：
 ：
 ↓転記すると
 「シート2」転記先シート
 [2]日付　番号　名前　商品A　数量　金額
 [3]日付　番号　名前　商品B　数量　金額

二回目の転記

「シート1」
 F1　日付
 A2　番号
 A3　名前
 を

 A8　商品C　数量　金額　
 A9　商品D　数量　金額
 ：
 ：
 ↓転記するとデータが上書きされます。
 「シート2」転記先シート
 [2]日付　番号　名前　商品C　数量　金額
 [3]日付　番号　名前　商品D　数量　金額

二回転記ごのほしい結果

「シート2」
 [2]日付　番号　名前　商品A　数量　金額
 [3]日付　番号　名前　商品B　数量　金額
 [2]日付　番号　名前　商品C　数量　金額
 [3]日付　番号　名前　商品D　数量　金額

 さくら

----
 データをそのように蓄積していくのですね。。
 jがSheet2の最終行+1です。。

 Sub test()
    Dim i As Long
    Dim j As Long
    
    Sheets("Sheet1").Activate
    i = Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("Sheet2")
    j = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        Range(.Cells(j, 1), .Cells(j + i - 8, 1)).Value = Range("F1").Value
        Range(.Cells(j, 2), .Cells(j + i - 8, 2)).Value = Range("A2").Value
        Range(.Cells(j, 3), .Cells(j + i - 8, 3)).Value = Range("A3").Value
        Range(.Cells(j, 4), .Cells(j + i - 8, 6)).Value = Range(Cells(8, 1), Cells(i, 3)).Value
    End With
 End Sub
 (kei)
----
 keiさんありがとうございます。
 思い通りの結果をへることができました。

 後二つ条件をついかできませんか？？
 　・シート2転記する行分の書式をコピーしたいです。

   ・シート2の　M列＝B列の月のみ取り出したいですが、今のコードに
 　変換するにはどうしたらいいのでしょか？
 　↓今使用しているマクロです。
           .Cells(j, "M").Value = Month(.Cells(j, "B").Value)
      
     '書式のコピー
         .Cells(j - 1, "A").Resize(1, 13).Copy
         .Cells(j, "A").Resize(1, 13).PasteSpecial Paste:=xlPasteFormats

 さくら
----
 >・シート2の　M列＝B列の月のみ取り出したいですが、
 意味が分かりません。。
 書式もSheet2へ持ってきたいのなら、今の Value=Value のやり方ではなく、Copyメソッドが適切だと思います。。
 Sheet1とSheet2のM列を含んだ「図表」を提示してください。
 提示された追加分を処理するのなら、考え方を整理しないと・・・ ^^
 (kei)
----
 書式も必要なら、、、
 
Sub test3()
    Dim i As Long
    Dim j As Long
    
    Sheets("Sheet1").Activate
    i = Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("Sheet2")
    j = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        Range("F1").Copy Range(.Cells(j, 1), .Cells(j + i - 8, 1))
        Range("A2").Copy Range(.Cells(j, 2), .Cells(j + i - 8, 2))
        Range("A3").Copy Range(.Cells(j, 3), .Cells(j + i - 8, 3))
        Range(Cells(8, 1), Cells(i, 3)).Copy .Cells(j, 4)
    End With
 End Sub

 >・シート2の　M列＝B列の月のみ取り出したいですが、
 ここの意味が不明です。。

 (kei)
----
 keiさんありがとうございます。

 「シート2」 
−−−−−−−−−−−−−−−−−−−−−−−−
 [2]日付 | 番号 |　名前 |　商品A |　数量 | 金額
−−−−−−−−−−−−−−−−−−−−−−−−
 [3]日付 | 番号 |　名前 |　商品B |　数量 | 金額
−−−−−−−−−−−−−−−−−−−−−−−−
 転記後
−−−−−−−−−−−−−−−−−−−−−−−−
 [2]日付 | 番号 |　名前 |　商品A |　数量 | 金額
−−−−−−−−−−−−−−−−−−−−−−−−
 [3]日付 | 番号 |　名前 |　商品B |　数量 | 金額
−−−−−−−−−−−−−−−−−−−−−−−−
 [4]日付　番号　名前　商品C　数量　金額
 [5]日付　番号　名前　商品D　数量　金額

 シート2の上の行の書式をコピーする　
 結果↓
−−−−−−−−−−−−−−−−−−−−−−−−
 [2]日付 | 番号 |　名前 |　商品A |　数量 | 金額
−−−−−−−−−−−−−−−−−−−−−−−−
 [3]日付 | 番号 |　名前 |　商品B |　数量 | 金額
−−−−−−−−−−−−−−−−−−−−−−−−
 [4]日付 | 番号 |　名前 |　商品A |　数量 | 金額
−−−−−−−−−−−−−−−−−−−−−−−−
 [5]日付 | 番号 |　名前 |　商品B |　数量 | 金額
−−−−−−−−−−−−−−−−−−−−−−−−
 シート1の書式はコピーしません。

 test3はエラーで出来ませんでした。

 さくら

----
 それでは、Sheet1からデータを一気に転記して、その後にSheet2のA2:F2までの書式を
 転記した行数分だけ、書式のコピーを実行すれば良いのでは?
 下記でダメなら、Sheet2のセルの結合などのデータの配置を提示して!

 Sub test4()
    Dim i As Long
    Dim j As Long

    Sheets("Sheet1").Activate
    i = Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("Sheet2")
    j = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        Range(.Cells(j, 1), .Cells(j + i - 8, 1)).Value = Range("F1").Value
        Range(.Cells(j, 2), .Cells(j + i - 8, 2)).Value = Range("A2").Value
        Range(.Cells(j, 3), .Cells(j + i - 8, 3)).Value = Range("A3").Value
        Range(.Cells(j, 4), .Cells(j + i - 8, 6)).Value = Range(Cells(8, 1), Cells(i, 3)).Value
        .Range("A2:F2").Copy
        Range(.Cells(j, 1), .Cells(j + i - 8, 6)).PasteSpecial Paste:=xlPasteFormats
    End With
 End Sub
 どうかなぁ?(kei)
----
keiさん最後までお付き合いいただきありがとうございます。

お陰さまで自分のやりたいことがすべて思い通りになりました。

本当にありがとうございます。

さくら