[[20251104171006]]　『こういうマクロってできますか』（イエロー）　ページの最後に飛ぶ

『こういうマクロってできますか』（イエロー）

はじめまして
例えば
シート１に
いぬ
ねこ
さる
とあった場合
任意の回数ここでは２回
シート２に
いぬ
ねこ
さる
いぬ
ねこ
さる
として
さらに
いぬ
いぬ
ねこ
ねこ
さる
さる
みたいに繰り返せるマクロってできますでしょうか
よろしくお願いします

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

 For..Nextを使えばできるので、トライしてみませんか？

 なお、仕様の確認ですが、
 ．．．
 さらに
 ．．．
 とありますが、さらに下に続けて計12行を作りたいのですか？
 それとも最後の
 いぬ
 いぬ
 ねこ
 ねこ
 さる
 さる
 の6行が最終目的なのか明確にされたらどうですか？
　
（xyz） 2025/11/04(火) 18:11:57

すいません書き方が悪かったです
最終的には
いぬ

 いぬ
 ねこ
 ねこ
 さる
 さる
の６行にしたいです
（イエロー） 2025/11/04(火) 19:07:48

 Sub test()
     Const n     As Long = 2     '繰返し回数
     Const startpos As Long = 1  '書き込みを開始する行の行番号
     Dim ws1     As Worksheet
     Dim ws2     As Worksheet
     Dim startRow As Long        '転記元の開始行
     Dim lastRow As Long         '転記元の終了行
     Dim p       As Long
     Dim j       As Long
     Dim k       As Long

     Set ws1 = Worksheets("Sheet1")
     Set ws2 = Worksheets("Sheet2")
     startRow = 1
     lastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row

     p = startpos
     For j = 1 To lastRow
         For k = 1 To n
             ws2.Cells(p, "A") = ws1.Cells(j, "A")
             p = p + 1
         Next
     Next
 End Sub

 【お願い事項】
 1．意味不明な箇所について質問してください。(ひょっとすると間違ったところがあるかもしれません）
 2. ご自分で詰まっていたところはどんなところだったのか教えて下さい。

（xyz） 2025/11/04(火) 19:26:04

 単純に

 Sub test()
     With Sheets("sheet1").[a1].CurrentRegion.Columns(1)
         .Copy Sheets("sheet2").[a1].Resize(.Rows.Count * 2)
     End With
 End Sub
　
（jindon） 2025/11/04(火) 19:59:27

 Sub test()
     Dim ws1 As Worksheet, ws2 As Worksheet, i As Long
     Set ws1 = Worksheets("シート1")
     Set ws2 = Worksheets("シート2")
     For i = 1 To ws1.Cells(Rows.Count, "A").End(xlUp).Row
         ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(2, 1) = ws1.Cells(i, "A")
     Next
 End Sub

 A1セルが空欄の場合A2セルから入力されるので　ws2.Range("A1").Delete Shift:=xlUp　とかする必要があります
（あ） 2025/11/04(火) 20:47:17

最終的には

 >いぬ
 >いぬ
 >ねこ
 >ねこ
 >さる
 >さる
 の６行にしたいです

 Sub test()
    Dim i&, n&, mySize$
    mySize = 2
    With Sheets("sheet1").[a1].CurrentRegion.Columns(1)
        For i = 1 To .Rows.Count
            n = n + IIf(n, mySize, 1)
            Sheets("sheet2").Cells(n, 1).Resize(mySize) = .Cells(i)
        Next
    End With
End Sub
　
（jindon） 2025/11/04(火) 20:50:50

みなさんありがとうございます
皆さんのコメントを見て気がついたのですがこれって仮に複数列の場合とどうすればよろしいでしょうか
すいませんがよろしくお願いします
（イエロー） 2025/11/05(水) 19:12:04

 >皆さんのコメントを見て気がついたのですが

条件を提示するのはあなたです。
せめて元データと結果図を行列がわかるように提示してください
（誰だって二度手間は嫌です）

（あ） 2025/11/05(水) 22:14:51

 Sub main()
     Dim data, res(), i, j, k, r, rep
     rep = 2 ‘任意の回数
     data = Cells(1, 1).CurrentRegion.Value
     ReDim res(1 to UBound(data, 1) * rep, 1 to UBound(data, 2))

     r= 1
     For i = 1 to UBound(data, 1)
         For k = 1 to rep
             For j= 1 to UBound(data,2)
                 res(r, j) = data(i, j)
             Next j
             r = r + 1
         Next k
     Next i

     Cells(1, 1).Offset(0, UBound(data, 2)).Resize(UBound(res, 1), UBound(res, 2)).Value = res
 End Sub

（Asa） 2025/11/05(水) 22:51:12

 シートを考慮していませんでした。すみません。

 data = Sheets("シート1").Cells(1,1).CurrentRegion.Value

 Sheets("シート2").Cells(1, 1).Resize(UBound(res, 1), UBound(res, 2)).Value = res

 こちらの2点を変更してください

（Asa） 2025/11/05(水) 22:56:26

遅れましたがありがとうございました
（イエロー） 2025/12/02(火) 19:46:53

コメント返信：

[ 一覧(最新更新順) ]

[[20251104171006]] 『こういうマクロってできますか』（イエロー） ページの最後に飛ぶ

[[20251104171006]]　『こういうマクロってできますか』（イエロー）　ページの最後に飛ぶ