تکرار یک مقدار با تعداد مشخص در اکسل

[reza_1001]

با سلام و خسته نباشید خدمت همه اساتید و دوستان
بنده یک مشکلی در اجرای sub دارم بدین صورت که :
میخواهم a1 را 24 بار تکرار کنم ، 24 بار تکرار میشه ولی هر بار 1 واحد اضافه میشه .
نمیدونم مشکل فرمول کجاس ، لطفا کمکم کنید .
اینم فرمول :

Sub Macro1()
'
' Macro1 Macro
'


'
j = 1
For i = 1 To 161
Range("A" & i & ":G" & i).Copy
Range("I" & j).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("I" & j & ":O" & j + 24), Type:=xlFillDefault
j = j + 24
Next i
ActiveWorkbook.Save
End Sub

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.

[~M*E*H*D*I~]

منظور از a1 اگر تو قطه کد

Range("A" & i & ":G" & i) 

هست ، خیلی واضحه شما شمارنده i رو به a اختصاص دادید بنابر این ستون a ردیف های 1 الی 24 را انتخاب میکنید برای ایکه سلول a1 ثابت باشه نباید براش شمارنده بذارید

[reza_1001]

سلام آقا مهدی ....لطفا فرمول اصلاح شده رو مینویسید

[~M*E*H*D*I~]

سلام آقا مهدی ....لطفا فرمول اصلاح شده رو مینویسید

سلام به شما ، اون g هم باید ثابت باشه؟یعنی رنج a1:g1 ؟

[reza_1001]

بله باید ثابت باشه

[~M*E*H*D*I~]

بایستی به صورت زیر بنویسید

for i=1 to 24
range("a1:g1").copy
next i 

[reza_1001]

اقا مهدی فایل رو پیوست کردم ، لطفا ببینیدش ، بنده میخوام که a1 رو 24 بار تکرار کنه و سپس a2 رو 24 بار کنه و الی آخر .

[~M*E*H*D*I~]

از کد زیر میتونی استفاده کنی

Sub InsertRows()
    Dim I As Long, j As Integer, Nb As Integer
    
    For I = Range("A65536").End(xlUp).Row To 1 Step -1
        
             Nb = 24
        
        For j = 1 To Nb - 1
            Rows(I + j).Insert xlDown
            Rows(I).Copy
            Rows(I + j).PasteSpecial    '
        Next
        
    Next
  
    Range("A1").Select
    Application.CutCopyMode = False
End Sub 

[~M*E*H*D*I~]

از کد زیر هم میتونی استفاده کنی

Sub test()
Dim i As Integer, j As Integer, n As Integer, p As Integer
Dim tedadcell As Integer
Dim tedadtekrar As Integer
tedadcell = 20
tedadtekrar = 15
n = 0
For j = 1 To tedadcell
  For i = j To tedadtekrar + j - 1
  Cells(j, 1).Copy
  Cells(i + n, 4).PasteSpecial xlPasteValues
  Next i
  n = n + tedadtekrar - 1
  Next j
 
End Sub