افزودن ردیف به شیت مطابق با فرمتی خاص

[mobinsaffarpour]

جناب آقای پارسا

باسلام و عرض ادب

خدمت شما عرض کنم که دقیقاً هر دو مورد وجود داره :

1 - امکان اینکه ردیف خالی در بین ردیف های دیگر وجود داشته باشه زیاد هست .

2 - امکان اینکه در سلول های دیگر به غیر از ستون a اطلاعات وجود داشته باشه هم زیاد هست.

[mobinsaffarpour]

جناب آقای پارسا عزیز

میشه لطف کنید و اینکه پست رو تکمیل کنید . /باتشکر و عرض پوزش

[Ali Parsaei]

از اين کد استفاده کنيد:

Dim C As Integer
Dim D As Integer
C = Range("A:K").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Rows("3:3").Select
    Selection.Copy
For D = 4 To C
    Rows(D).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Next D
Application.CutCopyMode = False
Cells(D, 1).Select 

[mobinsaffarpour]

متشکرم آقای پارسا واقعاً جالب و کاربری خیلی لطف کردید . سپاسگذارم

[Ali Parsaei]

گفته بوديد تعداد سطرهايتان بالاي 35000 تا ممکن است باشد!
چنين محاسباتي با اکسل غير معقول است! ضمن اينکه کد فوق نيز به درد آن نمي خورد و تقريبا" وقت تلف کردن مي باشد!
با اين وجود اگر در محدوده خارج ستونهاي A تا K هيچ نوشته يا عبارتي در سلها درج نکرده باشيد از اين کد که فوق العاده سريعتر عمل مي کند مي توانيد استفاده کنيد:
(خط اول کد جهت انتخاب محدوده و کل خطهاي بعدي صرفا" جهت فرمت دهي به محدوده انتخابي است)

Range(Cells(3, 1), Cells(Selection.SpecialCells(xlCellTypeLastCell).Row, 11)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 16777164
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.249977111117893
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.249977111117893
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.249977111117893
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.249977111117893
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.249977111117893
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.249977111117893
        .Weight = xlThick
    End With 

[mobinsaffarpour]

متشکرم جناب پارسا عزیز واقعاً متشکرم خیلی زحمت دادم .