戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
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:ゆう-G