[[20190918121637]]　『100行のデータを繰り返しコピー（1行ずつのデータ』（初心者）　ページの最後に飛ぶ

『100行のデータを繰り返しコピー（1行ずつのデータを3行ずつにしたい）』（初心者）

すでにあるVBAを用いたツールを改変しており、質問いたします。
エクセルはMOS取得程度、VBA初心者です。
ツールは別の方が作られたもので、作成者はすでに不在のため質問することができません。

A～Z列まで項目があり、約100行あるレコードを縦に繰り返しコピーする方法を模索しております。

約100行のボリュームは、変動します。
またそのデータは別のtsvファイルから、マクロのボタンでインポートし、空白のシートにコピーされます。
コピーした後は、別のマクロのボタンで絞り込みをし、
最終的に、原本.xlsmに書き出します。

最終的に書き出された際に、もともと1行ずつだったレコードが、3行ずつになるような方法はありますでしょうか。
並び順は、同じレコードが3行続くのが必須ですが、そちらは解消しております。

不足する情報がありましたら、ご指摘ください。
よろしくお願いいたします。

＜使用 Excel：Office365、使用 OS：Windows10 ＞

 なにがわかりませんか？

 ・行数の取得？
 ・貼り付け先の取得？

 1行目が見出しだったりしますか？

（渡辺ひかる） 2019/09/18(水) 13:06

 こんにちは＾＾回答では有りません　m(_ _)m
恐怖と憶測の独りよがりのデタラメコードです。興味が御有りでしたら、新規ｂｏｏｋにて
御試しを、私の勘違いでしたら。ゴミ箱ぽい、お願いいたします。でわ

 元情報も良くわかりませんでしたので仮想データーもご用意しました。＾＾；
Sheet2　が　結果図となります。　(￣▽￣；。。。m(_ _)m
 Option Explicit
Sub OneInstance()
    Dim Base          As Variant
    Dim i             As Long
    Dim Y             As Long
    With Worksheets("Sheet1")
        .Cells.Clear
        Dum
        Base = .Cells(1).CurrentRegion
    End With
    With Worksheets("Sheet2")
        .Cells.Clear
        Y = 2
        .Cells(1).Resize(, UBound(Base, 2)) = WorksheetFunction.Index(Base, 1, 0)
        For i = 2 To UBound(Base, 1)
            .Cells(Y, 1).Resize(, UBound(Base, 2)) = WorksheetFunction.Index(Base, i, 0)
            .Cells(Y, 1).Offset(1).Resize(, UBound(Base, 2)) = WorksheetFunction.Index(Base, i, 0)
            .Cells(Y, 1).Offset(2).Resize(, UBound(Base, 2)) = WorksheetFunction.Index(Base, i, 0)
            Y = Y + 3
        Next
    End With
End Sub
Private Sub Dum()
    Dim i As Long
    Dim Base As Variant
    Dim rr As Range
    Dim r As Range
    With Worksheets("Sheet1")
        .Cells(1).Resize(, 5) = Array("A", "B", "C", "D", "E")
        For i = 2 To 100
            .Cells(i, 1).NumberFormatLocal = "@"
            .Cells(i, 1) = Format(i - 1, "00000")
            If .Cells(i, 1).Errors.Item(xlNumberAsText).Ignore = False Then
                .Cells(i, 1).Errors.Item(xlNumberAsText).Ignore = True
            End If
            .Cells(i, 2) = .Cells(i, 2).Address(0, 0)
            .Cells(i, 3) = .Cells(i, 3).Address(0, 0)
            .Cells(i, 4) = .Cells(i, 4).Address(0, 0)
            .Cells(i, 5) = .Cells(i, 5).Address(0, 0)
        Next
    End With
End Sub
（隠居じーさん） 2019/09/18(水) 13:36

 （隠居じーさん）さん

 ＞並び順は、同じレコードが3行続くのが必須ですが、そちらは解消しております。

 とあるので、コピペだけでいいのでは？
 多分コピペした後、何かのキーでソートでもするんでしょう。

（渡辺ひかる） 2019/09/18(水) 13:42

隠居じーさん様

書き込みしました情報が少ない中、
コードを作成くださり、ありがとうございます。

この返信後、新規bookにて挑戦させていただきたいと思います。
ありがとうございます。

渡辺ひかる様

この度はコメント返信くださり、ありがとうございます。
おっしゃる通り、1行目が見出しになっており、コピペを必要としております。

今回のような動作をさせたい場合、
「行数を取得し、コピーする範囲を選択、
貼り付け先を指定し、ペースト」
という流れになりますでしょうか。
（初心者） 2019/09/18(水) 14:14

渡辺ひかるさま
なるほど。。。見落としていました。
ありがとう御座いました。

m(_ _)m

（隠居じーさん） 2019/09/18(水) 14:40

 遅れましたけど

 Sub test()
    Dim mySht As Worksheet
    Dim myRng As Range
    Dim i As Long

    Set mySht = Worksheets("Sheet1")

    With mySht.Range("A1").CurrentRegion
        Set myRng = .Offset(1).Resize(.Rows.Count - 1)
    End With

    For i = 1 To 2
        myRng.Copy mySht.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next

 End Sub

（渡辺ひかる） 2019/09/21(土) 20:11

コメント返信：

[ 一覧(最新更新順) ]

[[20190918121637]] 『100行のデータを繰り返しコピー（1行ずつのデータ』（初心者） ページの最後に飛ぶ

[[20190918121637]]　『100行のデータを繰り返しコピー（1行ずつのデータ』（初心者）　ページの最後に飛ぶ