[حل شده] Fill خودکار

[ali.b]

سلام وثت دوستان بخیر

این فایل اکسل که قرار دادم ی محدوده رو از شیت 1 به شیت دو میبره و با هر بار اجرای ماکرو اطلاعات جدید رو زیر اطلاعات قبلی قرار میده

من میخوام ی کدی هم باشه وقتی مقدار A رو هر بار کپی میکنه بر مبنای تعداد مقادری که که کپی میکنه برام FILL کنه
مثلا ممکنه 10 ردیف رنج باشه و a رو برای 10 ردیف FILL کنه و اگه مقدار کپی 5 تا بود برای اون 5 تاFIL کنه

ممنونم

[ali.b]

Sub Macro3()
Dim A
A = Sheet1.Range("A1")
Sheet1.Select
    Range("B2:D4").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
        Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = A
        Range("A" & Rows.Count).End(xlUp).Select
Call test2
End Sub

Sub test2()
Dim LastRow As Long
With Worksheets("Sheet2")
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
.Range("A2").AutoFill Destination:=.Range("A2:A" & LastRow) _
, Type:=xlFillDefault
End With
End Sub

با این کد هر بار ران میشه محدوده اطلاعات من اخر هر رنج قرار میگیره و به همراهش ی کاراکتر هم اضافه میکنه و من میخوام این کاراکتر دا در واقع شماره هر بار که محدوده کپی میشه به میزان ردیف محدوده اونم سورت بشه

مثلا ی سند دارم شماره 1 لیستش 10 تایی هست وقتی این لیست 10 تایی در ستون b درج شد در ستون a هم شماره سند ها به اندازه 10 تا معادل اون رنج کپی شه

این کد همون کار رو میکنه اما مشکل من اینجاست که از A2 شروع به fill کردن میکنه و من میخوام از هر جا که سلول انتخاب شده هست رو به پایین Fill کنه
یعنی از اینجا که این کد انتخاب میکنه

Range("A" & Rows.Count).End(xlUp).Select

[mch2v]

سلام
ببینید این خوبه
فقط دقت کنید سلول هایی رو که با ماوس سلکت میکنید کپی میکنه

[Amir Ghasemiyan]

سلام

از این کد استفاده کن. (تا جایی که میتونی از select استفاده نکن. "از آموزه های استاد امین اسماعیلی")

Sub Macro3()
Dim A
A = Sheet1.Range("A1")
Sheet1.Range("B2:D4").Copy
LastRow = Sheet2.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row
Sheet2.Range("B" & LastRow).PasteSpecial xlPasteValues
newlastrow = Sheet2.Range("B" & Rows.Count).End(xlUp).Row
Sheet2.Range("A" & LastRow & ":A" & newlastrow) = A
End Sub