□ 戻る　 □一般操作のサロン　 □ 使用方法　 □ 新着記事 　□ 新規に質問する！　 □ トピック一覧　 □ 検索 　□ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
resize　と　offset

    [195891] resize　と　offset-

    ■親トピック/記事引用/メール受信=OFF■

    □投稿者/ Green -(2023/08/20(15:23))
    □U R L/ 
      初めまして宜しくお願い致します。
このコピー貼付けを　resize　と　offset　を使ってループしたいのですが、
教えてください。　Windows10　Excel2019

−−−−−−−−
        Sheets(コピー元).Range("D5:F9").Copy
        Sheets(貼付け先).Range("C3:E7").PasteSpecial xlPasteValues
        
        Sheets(コピー元).Range("H5:J9").Copy
        Sheets(貼付け先).Range("F3:H7").PasteSpecial xlPasteValues
        
        Sheets(コピー元).Range("L5:N9").Copy
        Sheets(貼付け先).Range("I3:K7").PasteSpecial xlPasteValues
        
        Sheets(コピー元).Range("P5:R9").Copy
        Sheets(貼付け先).Range("L3:N7").PasteSpecial xlPasteValues
−−−−−−−−



Sub コピー_ループ()
    Dim sn1 As String
    Dim sn2 As String
    Dim baseCell1 As Range
    
        Set baseCell1 = Sheets("コピー元").Range("D5")
        
        Dim rowOffset As Long
        Dim n As Long
        
        For rowOffset = 0 To 3
            For n = 0 To 2
                baseCell1.Offset(rowOffset, 0).Resize(5, 3).Copy
                
                Sheets("貼付け先").Cells(3 + rowOffset, n + 3).PasteSpecial xlPasteValues
            
            Next n
        Next rowOffset

End sub


−−コピー元−−−−−−
1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19
2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20
3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21
4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22
5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23
6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24
7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25
8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26
9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27
10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28
−−−−−−−−


−−コピー元−−−−−−
																	
																	
																	
																	
			8	9	10		12	13	14		16	17	18		20	21	22
			9	10	11		13	14	15		17	18	19		21	22	23
			10	11	12		14	15	16		18	19	20		22	23	24
			11	12	13		15	16	17		19	20	21		23	24	25
			12	13	14		16	17	18		20	21	22		24	25	26
																	
−−−−−−−−

　　↓

−−貼付け先−−−−−−
													
													
		8	9	10	12	13	14	16	17	18	20	21	22
		9	10	11	13	14	15	17	18	19	21	22	23
		10	11	12	14	15	16	18	19	20	22	23	24
		11	12	13	15	16	17	19	20	21	23	24	25
		12	13	14	16	17	18	20	21	22	24	25	26
													
−−−−−−−−



      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他



    [195892] Re[1]: resize　と　offset-

    ■記事引用/メール受信=OFF■

    □投稿者/ 半平太 -(2023/08/20(16:00))
    □U R L/ 
      こんな感じですかね？

Sub コピー_ループ()
    Dim baseCell1 As Range
    Dim baseCell2 As Range
    Dim colOffset As Long
    
    Set baseCell1 = Sheets("コピー元").Range("D5")
    Set baseCell2 = Sheets("貼付け先").Range("C3")
    
    For colOffset = 0 To 3
        baseCell1.Offset(0, colOffset * 4).Resize(5, 3).Copy '
        baseCell2.Offset(0, colOffset * 3).PasteSpecial xlPasteValues
    Next colOffset
End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他



    [195893] Re[2]: resize　と　offset-

    ■解決！！ありがとうございました！ / 記事引用/メール受信=OFF■

    □投稿者/ Green -(2023/08/20(17:22))
    □U R L/

      できました。ありがとうございます。
      複雑に考えていました。(#^.^#)



このトピック内容の全ページ数 / [0]

このトピックに書きこむ
Name/
E-Mail/

└>このツリーのレス記事をメールで受信しますか? YES/ NO/
Title/
URL/
Comment/ 通常モード->　 図表モード-> (←の場合適当に改行を入れて下さい)
タグが使用できます。例 ⇒ <font color="blue">文字</font>
解決！！ありがとうございました！ 解決       保留中です・・・ 保留        迷宮入りorほかあたって見ます・・ 迷宮入       すいませ〜ん。誰か〜！ Help! ←※回答者専用
解決したらチェック       保留(コードテスト中など・・)         解決不可orレスが全く付かなくてほかのサイトに行くときなど・・
削除キー/
(半角8文字以内)　

- Child Forum -
Edit:ゆう-Ｇ