درخواست جمع کردن فاکتور های یک شیت در یک شیت دیگر

[rezayavar]

سلام ضمن خسته نباشید عزیزان یک فایل مخارج دارم که شامل ماههای سال میباشد در هر ماه هر چی خرید میشه داخل اون مینویسم(نمونه ضمیمه میباشد) میخوام در شیت حسابرسی ببینم کدوم جنس از همه بیشتر مصرف میشه یا به عنوان مثال بنزین کدوم ماه از همه بیشتر شده یک قسمت رو از برنامه های همین سایت نوشتم ولی منظورم اینه که در شیت حسابرسی بطور اتومات از همه ماهها ستون 1 شرح یا همون کالا رو برداره اگه تکرار شده بود جمع بده اگه یکبار فقط ثبت شده بود خودش رو بنویسه و قیمت رو بزنه بره یکی بعدی
با احترام اکبریه

[iranweld]

با سلام

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

[amir_ts]

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

Sub UniqueValues()
Dim  r As Long, N As Long, i As Integer
Application.ScreenUpdating = False
N = 2
For i = 1 To Sheets.Count - 1
If Sheets(i).Name <> "حساب" Then
r = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row
Sheets(i).Range("A2:A" & r).Copy
Cells(N, 1).PasteSpecial xlValues
N = Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
Next


  Columns("A:A").Select
  ActiveSheet.Range("$A$1:$A$1000").RemoveDuplicates Columns:=Array(1), _
  Header:=xlNo
  Range("A1").Select


Application.ScreenUpdating = True
End Sub

[rezayavar]

با سلام

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

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

[rezayavar]

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

Sub UniqueValues()
Dim  r As Long, N As Long, i As Integer
Application.ScreenUpdating = False
N = 2
For i = 1 To Sheets.Count - 1
If Sheets(i).Name <> "حساب" Then
r = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row
Sheets(i).Range("A2:A" & r).Copy
Cells(N, 1).PasteSpecial xlValues
N = Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
Next


  Columns("A:A").Select
  ActiveSheet.Range("$A$1:$A$1000").RemoveDuplicates Columns:=Array(1), _
  Header:=xlNo
  Range("A1").Select


Application.ScreenUpdating = True
End Sub

از شما بزرگوار هم ممنونم ولی نتونستم در فایل اصلی منتقل کنم حتی ماکرو هم کپی کردم ولی باز همان فایل ارسالی شما رو میخواد و ارور میده"facto1" در ضمن من فایل خودم رو به فایل شما انتقال دادم شرح و میلغ رو تا ردیف 62 میاره از 63 به بعد تا انتها شرح داره ولی مبلغ نداره و در موقع سیو کردن این ارور رو میده لطف میفرمایید راهنمایی کنید

[iranweld]

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

انتقال دیتا بصورت اتوماتیک فقط با ماکرونویسی امکان پذیر است.

[amir_ts]

کلید Alt+F11 رو فشار بدید و کد ها رو داخل یک ماژول کپی کنید.
شیت حسابرسی رو به شیت حساب تغییر نام بدید.

[rezayavar]

انتقال دیتا بصورت اتوماتیک فقط با ماکرونویسی امکان پذیر است.

سلام لطف میفرمائید یک ماژول در همین زمینه برام بزارید

[rezayavar]

کلید Alt+F11 رو فشار بدید و کد ها رو داخل یک ماژول کپی کنید.
شیت حسابرسی رو به شیت حساب تغییر نام بدید.
[ATTACH]12611[/ATTACH]

سلام استاد به همین روش که فرمودید عمل کردم وقتی خروج میزنم و دوباره فایل رو باز میکنم ماژولها نیست راهنمایی میفرمائید

[amir_ts]

با سلام
بعد از کپی کدها فایل رو save as کنید و از گزینه های لیست آبشاری save as type گزینه دوم Excel-Macro Enable Workbook رو انتخاب کنید تا کد ها ذخیره شود.

[rezayavar]

با سلام
بعد از کپی کدها فایل رو save as کنید و از گزینه های لیست آبشاری save as type گزینه دوم Excel-Macro Enable Workbook رو انتخاب کنید تا کد ها ذخیره شود.

سلام ضمن تشکر از جنابعالی بفرمائید این ارور به چه صورت رفع میشه

[amir_ts]

با سلام
دوست عزیز این پیغام امنیتی ایست.
برای حذف پیغام باید از قسمت File>Excel Options > Trust Center/Trust Center Settings > Document-specific Settings تیک گزینه مورد نظر رو بردارید.

[rezayavar]

انتقال دیتا بصورت اتوماتیک فقط با ماکرونویسی امکان پذیر است.

سلام عزیز میشه ماکرو همین رو برام بزارید؟

[iranweld]

سلام عزیز میشه ماکرو همین رو برام بزارید؟

کد انتقال دیتا از شیت های مختلف به شیت data

Private Sub CommandButton1_Click()

Sheets("DATA").Range("A1") = "نام شيت"

Sheets("DATA").Range("B1") = "شرح"

Sheets("DATA").Range("C1") = "قيمت"

Z3 = Sheets("DATA").Cells(Sheets("DATA").Rows.Count, "B").End(xlUp).Row + 1

Sheets("DATA").Range("A2:C" & Z3).ClearContents

For Each Sheet In Worksheets

K1 = Sheet.Cells(Rows.Count, "A").End(xlUp).Row

If Sheet.Name <> LCase("DATA") And Sheet.Name <> LCase("REPORT") And K1 > 1 Then

Z2 = Sheets("DATA").Cells(Sheets("DATA").Rows.Count, "B").End(xlUp).Row + 1

Sheet.Range("A2:B" & K1).Copy Destination:=Sheets("DATA").Range("B" & Z2)

Z3 = Sheets("DATA").Cells(Sheets("DATA").Rows.Count, "B").End(xlUp).Row

Range("A" & Z2 & ":A" & Z3) = Sheet.Name

End If

Next Sheet

End Sub