ایراد در کپی کردن

**M_ExceL** · 2019/06/10, 15:51

نوشته اصلی توسط ناصر خان خان

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

ممنونم.

سلام،

کد:

Sub enteqal123()
Application.ScreenUpdating = False
    lrow1 = Sheets("data").Range("b" & Rows.Count).End(3).Row
    lrow2 = Sheets("database").Range("a" & Rows.Count).End(3).Row + 1
    drow = WorksheetFunction.CountA(Sheets("data").Range("b1:b" & lrow1)) - 2

        Sheets("data").Range("b" & drow + 7).Copy
        Sheets("database").Range("a" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("a" & lrow2).PasteSpecial (xlPasteFormats)
        
        Sheets("data").Range("w" & drow + 7).Copy
        Sheets("database").Range("b" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("b" & lrow2).PasteSpecial (xlPasteFormats)
        
        Sheets("data").Range("c" & drow + 7).Copy
        Sheets("database").Range("c" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("c" & lrow2).PasteSpecial (xlPasteFormats)
        
        Sheets("data").Range("d" & drow + 7).Copy
        Sheets("database").Range("d" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("d" & lrow2).PasteSpecial (xlPasteFormats)
        
        Sheets("data").Range("e" & drow + 7).Copy
        Sheets("database").Range("e" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("e" & lrow2).PasteSpecial (xlPasteFormats)
        
        Sheets("data").Range("f" & drow + 7).Copy
        Sheets("database").Range("f" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("f" & lrow2).PasteSpecial (xlPasteFormats)
        
        Sheets("data").Range("g" & drow + 7).Copy
        Sheets("database").Range("g" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("g" & lrow2).PasteSpecial (xlPasteFormats)
        
        Sheets("data").Range("k" & drow + 7).Copy
        Sheets("database").Range("h" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("h" & lrow2).PasteSpecial (xlPasteFormats)
        
        Sheets("data").Range("l" & drow + 7).Copy
        Sheets("database").Range("i" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("i" & lrow2).PasteSpecial (xlPasteFormats)
        
        Sheets("data").Range("n" & drow + 7).Copy
        Sheets("database").Range("j" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("j" & lrow2).PasteSpecial (xlPasteFormats)
        
        Sheets("data").Range("o" & drow + 7).Copy
        Sheets("database").Range("k" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("k" & lrow2).PasteSpecial (xlPasteFormats)
        
        Sheets("data").Range("p" & drow + 7).Copy
        Sheets("database").Range("l" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("l" & lrow2).PasteSpecial (xlPasteFormats)
        
        Sheets("data").Range("q" & drow + 7).Copy
        Sheets("database").Range("m" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("m" & lrow2).PasteSpecial (xlPasteFormats)
        
        Sheets("data").Range("r" & drow + 7).Copy
        Sheets("database").Range("n" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("n" & lrow2).PasteSpecial (xlPasteFormats)
        
        Sheets("data").Range("s" & drow + 7).Copy
        Sheets("database").Range("o" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("o" & lrow2).PasteSpecial (xlPasteFormats)
        
        Sheets("data").Range("t" & drow + 7).Copy
        Sheets("database").Range("p" & lrow2).PasteSpecial (xlPasteValues)
        Sheets("database").Range("p" & lrow2).PasteSpecial (xlPasteFormats)
        
        Application.ScreenUpdating = True
        Sheets("data").Activate
Application.CutCopyMode = False
End Sub

**M_ExceL** · 2019/06/10, 18:14

کد:

Sub enteqal123()
Application.ScreenUpdating = False
    lrow1 = Sheets("data").Range("b" & Rows.Count).End(3).Row
    lrow2 = Sheets("database").Range("a" & Rows.Count).End(3).Row + 1
    drow = WorksheetFunction.CountA(Sheets("data").Range("b1:b" & lrow1)) + 5
         For s = 8 To drow
             If Sheets("data").Range("w" & s) <> Sheets("database").Range("b" & s - 6) Then
                 Sheets("database").Range("b" & s - 6) = Sheets("data").Range("w" & s)
                 Sheets("database").Range("a" & s - 6) = Sheets("data").Range("b" & s)
                 Sheets("database").Range("c" & s - 6) = Sheets("data").Range("c" & s)
                 Sheets("database").Range("d" & s - 6) = Sheets("data").Range("d" & s)
                 Sheets("database").Range("e" & s - 6) = Sheets("data").Range("e" & s)
                 Sheets("database").Range("f" & s - 6) = Sheets("data").Range("f" & s)
                 Sheets("database").Range("g" & s - 6) = Sheets("data").Range("g" & s)
                 Sheets("database").Range("h" & s - 6) = Sheets("data").Range("k" & s)
                 Sheets("database").Range("i" & s - 6) = Sheets("data").Range("l" & s)
                 Sheets("database").Range("j" & s - 6) = Sheets("data").Range("n" & s)
                 Sheets("database").Range("k" & s - 6) = Sheets("data").Range("o" & s)
                 Sheets("database").Range("l" & s - 6) = Sheets("data").Range("p" & s)
                 Sheets("database").Range("m" & s - 6) = Sheets("data").Range("q" & s)
                 Sheets("database").Range("n" & s - 6) = Sheets("data").Range("r" & s)
                 Sheets("database").Range("o" & s - 6) = Sheets("data").Range("s" & s)
                 Sheets("database").Range("p" & s - 6) = Sheets("data").Range("t" & s)
             End If
         Next s
    Sheets("data").Range("b8:q" & drow).Copy
    Sheets("database").Range("a2:p" & drow - 6).PasteSpecial (xlPasteFormats)
    Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub