دفتر معین (رفع نواقص)

**majid_mx4** · 2021/01/04, 16:54

با سلام
لطفا دستورات را بشکل زیر تغییر دهید.

کد:

Private Sub CommandButton4_Click()
On Error Resume Next
Dim c As Range

For Each c In Sheet6.Range("b4:b1000")
    For i = 1 To Sheets.Count
        If c.Value = Sheets(i).Name Then
            Sheets(i).Range("a3:F1000").ClearContents
            Range("g4").AutoFilter
            Sheet1.Range("$A$4:$G$9").AutoFilter Field:=7, Criteria1:= _
                c.Value
            Range("A3").Select
            Selection.End(xlDown).Select
            Range("a5", ActiveCell.Offset(0, 5)).Select
            Selection.Copy
            Sheets(i).Activate
            ActiveSheet.Range("a3").Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            Sheet1.Activate
            Range("G4").Select
            ActiveSheet.Range("$A$4:$G$9").AutoFilter Field:=7
            Exit For
        End If
    Next i
Next c
End Sub

پایدار باشید میر

**mona71** · 2021/01/04, 17:38

نوشته اصلی توسط majid_mx4

با سلام
لطفا دستورات را بشکل زیر تغییر دهید.

کد:

Private Sub CommandButton4_Click()
On Error Resume Next
Dim c As Range

For Each c In Sheet6.Range("b4:b1000")
    For i = 1 To Sheets.Count
        If c.Value = Sheets(i).Name Then
            Sheets(i).Range("a3:F1000").ClearContents
            Range("g4").AutoFilter
            Sheet1.Range("$A$4:$G$9").AutoFilter Field:=7, Criteria1:= _
                c.Value
            Range("A3").Select
            Selection.End(xlDown).Select
            Range("a5", ActiveCell.Offset(0, 5)).Select
            Selection.Copy
            Sheets(i).Activate
            ActiveSheet.Range("a3").Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            Sheet1.Activate
            Range("G4").Select
            ActiveSheet.Range("$A$4:$G$9").AutoFilter Field:=7
            Exit For
        End If
    Next i
Next c
End Sub

پایدار باشید میر

مرسی از لطفتون ولی تغییر ک میدم درست عمل نمیکنه، ینی باقیمانده رو نمیاره و مشتری جدید هم ثبت نمیکنه
لطف میکنید فایل و پیوست کنید؟

**majid_mx4** · 2021/01/04, 19:49

با سلام

هیچ تغییر در فایل شما انجام نشده است و فقط دستورات دکمه بروز رسانی مقداری تغییر کرده ، آنهم برای انتقال دو ستون باقیمانده و تشخیص.

فایل های پیوست شده

2معین.rar (85.6 کیلو بایت, مشاهدات 18)

**mona71** · 2021/01/05, 09:13

نوشته اصلی توسط majid_mx4

با سلام

هیچ تغییر در فایل شما انجام نشده است و فقط دستورات دکمه بروز رسانی مقداری تغییر کرده ، آنهم برای انتقال دو ستون باقیمانده و تشخیص.

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