請簡化錄製的程式碼

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

2^#

發表於 2021-7-23 15:29 | 顯示全部帖子

不好意思，漏了2列
'複製指定的DATA!A:I範圍，貼上6個工作表的AU2
Sub Macro1()
Range("A1850:I1875").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(Array("準3進4", "準4進5", "準5進6", "準6進7", "準7進8")).Select
Sheets("準3進4").Activate
Range("AU2").Select
ActiveSheet.Paste
End Sub

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

3^#

發表於 2021-7-23 16:37 | 顯示全部帖子

本帖最後由 ziv976688 於 2021-7-23 16:41 編輯

回復 3# ML089
謝謝您的指導~感恩

另外我把程式碼貼到DATA!
請問：下列的程式碼可以如何再簡(優)化?
謝謝您

TEST_連續複製.rar (84.14 KB)
Nrange = "1878" 'InputBox("請輸入運算的迄止期數", "輸入期數")
Num = "25" 'InputBox("請輸入複製的期距數範圍", "輸入距期數")

'連續複製
'列36
For Each xS In Sheets(Array("準3進4", "準4進5", "準5進6", "準6進7", "準7進8"))
      Sheets("DATA").Range("A" & Nrange - Num - 2, "I" & Nrange - 2).Copy xS.Range("AU2") '複製指定的DATA!A:I範圍貼上AU2
Next

For Each xS In Sheets(Array("準4進5", "準5進6", "準6進7", "準7進8"))
      Sheets("DATA").Range("A" & Nrange - Num - 3, "I" & Nrange - 3).Copy xS.Range("BD2")
Next

For Each xS In Sheets(Array("準5進6", "準6進7", "準7進8"))
      Sheets("DATA").Range("A" & Nrange - Num - 4, "I" & Nrange - 4).Copy xS.Range("BM2")
Next

For Each xS In Sheets(Array("準6進7", "準7進8"))
      Sheets("DATA").Range("A" & Nrange - Num - 5, "I" & Nrange - 5).Copy xS.Range("BV2")
Next

For Each xS In Sheets("準7進8")
      Sheets("DATA").Range("A" & Nrange - Num - 6, "I" & Nrange - 6).Copy xS.Range("CE2")
Next

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

4^#

發表於 2021-7-23 16:50 | 顯示全部帖子

回復 4# samwang
謝謝您的指導~感恩

5樓的需求~懇請賜教。
謝謝您

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

5^#

發表於 2021-7-23 23:27 | 顯示全部帖子

回復 9# ML089
版主 :您好!
複製範圍有誤差~

TEST_連續複製(測試).rar (85.57 KB)
謝謝您

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

6^#

發表於 2021-7-23 23:43 | 顯示全部帖子

回復 9# ML089
OK了

Sheets("DATA").Range("A" & Nrange - Num - Nrr(i), "I" & Nrange - 6).Copy Sheets(Srr(j)).Range(Prr(i))
改
Nrange - Nrr(i)
程式碼精簡很多，也學到許多語法。
謝謝您的耐心指導和幫忙~感恩

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

7^#

發表於 2021-7-24 01:33 | 顯示全部帖子

回復 9# ML089
版主 :
下列提問，懇請您指導 ~
http://forum.twbts.com/thread-23273-1-1.html
謝謝您 ! 晚安