मेरे पास निम्न कोड है जो सक्रिय लाइन की प्रतिलिपि बनाने के लिए उपयोग किया जाता है और इसे डेटा के अंत में पहली रिक्त, या उपलब्ध लाइन पर कई बार पेस्ट करता है। कोड उपयोगकर्ता को डेटा के अंत में कॉपी की गई पंक्ति को चिपकाने के लिए कितनी बार निर्दिष्ट करने के लिए प्रेरित करता है। हालांकि, यह ठीक से काम नहीं कर रहा है जब इसका उपयोग किया जा रहा डेटा सेट एक निश्चित फ़ील्ड पर फ़िल्टर किया जाता है। इसके बजाय यह मौजूदा डेटा पर चिपका रहा है जो फ़िल्टर किए गए डेटा के भीतर है। उदाहरण के लिए, यदि फ़िल्टर विकल्प लागू होने के कारण पंक्ति 699 दिखाई नहीं दे रही है और डेटा पंक्ति 700 पर समाप्त होता है, तो 701 पहली रिक्त पंक्ति होगी, यह पंक्ति 699 पर चिपका रही है। हालांकि, यह तब काम करता है जब उपयोगकर्ता सहेजता है बीच में। इस मुद्दे को कैसे ठीक किया जाए इस पर कोई विचार?

Sub Transfer()

Application.ScreenUpdating = False

Dim lastrow As Long
lastrow = Sheets("ForecastedMovement").Range("A65536").End(xlUp).Row    '   or + 1

On Error GoTo Finish
lngRows = CLng(InputBox("How many rows do you wish to add?"))
lngNextRow = Range("A" & Rows.Count).End(xlUp).Row + 1

Range("A" & ActiveCell.Row & ":BX" & ActiveCell.Row).Copy
Range("A" & lastrow + 1 & ":BX" & lastrow + lngRows).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Finish:
If Err.Number <> 0 Then MsgBox Prompt:="Please ensure you only enter numeric values!"

Application.ScreenUpdating = True

End Sub
0
NeilD137 4 अक्टूबर 2017, 17:43
एक टिप के रूप में, InputBox के बजाय Application.InputBox का उपयोग करें। फिर आप उपयोगकर्ता को On Error का उपयोग करने के बजाय एक नंबर दर्ज करने के लिए बाध्य कर सकते हैं। यानी Application.InputBox("How many rows do you wish to add?", Type:=1). यह केवल एक नंबर स्वीकार करेगा
 – 
Zac
4 अक्टूबर 2017, 18:02

1 उत्तर

सबसे बढ़िया उत्तर
Sub Transfer()

    Dim sht As Worksheet
    Dim lastrow As Long, lngRows

    Application.ScreenUpdating = False

    Set sht = Sheets("ForecastedMovement")

    lastrow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row + 1
    'account for filtered rows at end of dataset
    Do While Application.CountA(sht.Rows(lastrow)) > 0
        lastrow = lastrow + 1
    Loop

    On Error GoTo Finish
    lngRows = CLng(InputBox("How many rows do you wish to add?"))

    ActiveCell.EntireRow.Range("A1:BX1").Copy

    sht.Cells(lastrow, 1).Resize(lngRows).PasteSpecial Paste:=xlPasteValues

Finish:
    If Err.Number <> 0 Then MsgBox Prompt:="Please ensure you only enter numeric values!"

    Application.ScreenUpdating = True

End Sub
0
Tim Williams 4 अक्टूबर 2017, 19:55