एक्सेल में दिनांक के आधार पर पंक्तियों को कॉपी करके दूसरी शीट पर कैसे पेस्ट करें?
मान लीजिए, मेरे पास डेटा की एक श्रृंखला है, अब, मैं एक विशिष्ट तिथि के आधार पर पूरी पंक्तियों की प्रतिलिपि बनाना चाहता हूं और फिर उन्हें दूसरी शीट में पेस्ट करना चाहता हूं। क्या आपके पास Excel में इस कार्य से निपटने के लिए कोई अच्छा विचार है?
पंक्तियों को कॉपी करें और आज की तारीख के आधार पर दूसरी शीट पर पेस्ट करें
यदि दिनांक आज से अधिक है तो पंक्तियों की प्रतिलिपि बनाएँ और दूसरी शीट पर चिपकाएँ
पंक्तियों को कॉपी करें और आज की तारीख के आधार पर दूसरी शीट पर पेस्ट करें
यदि तारीख आज है तो आपको पंक्तियों की प्रतिलिपि बनाने की आवश्यकता है, कृपया निम्नलिखित VBA कोड लागू करें:
1. दबाए रखें ALT + F11 कुंजी को खोलने के लिए अनुप्रयोगों के लिए माइक्रोसॉफ्ट विज़ुअल बेसिक खिड़की.
2। क्लिक करें सम्मिलित करें > मॉड्यूल, और मॉड्यूल विंडो में निम्नलिखित कोड पेस्ट करें।
वीबीए कोड: आज की तारीख के आधार पर पंक्तियों को कॉपी और पेस्ट करें:
Sub CopyRow()
'Updateby Extendoffice
Dim xRgS As Range, xRgD As Range, xCell As Range
Dim I As Long, xCol As Long, J As Long
Dim xVal As Variant
On Error Resume Next
Set xRgS = Application.InputBox("Please select the date column:", "KuTools For Excel", Selection.Address, , , , , 8)
If xRgS Is Nothing Then Exit Sub
Set xRgD = Application.InputBox("Please select a destination cell:", "KuTools For Excel", , , , , , 8)
If xRgD Is Nothing Then Exit Sub
xCol = xRgS.Rows.Count
Set xRgS = xRgS(1)
Application.CutCopyMode = False
J = 0
For I = 1 To xCol
Set xCell = xRgS.Offset(I - 1, 0)
xVal = xCell.Value
If TypeName(xVal) = "Date" And (xVal <> "") And (xVal = Date) Then
xCell.EntireRow.Copy xRgD.Offset(J, 0)
J = J + 1
End If
Next
Application.CutCopyMode = True
End Sub
3. उपरोक्त कोड को पेस्ट करने के बाद कृपया दबाएँ F5 इस कोड को चलाने के लिए कुंजी, और एक प्रॉम्प्ट बॉक्स आपको उस दिनांक कॉलम का चयन करने की याद दिलाने के लिए पॉप अप होगा जिसके आधार पर आप पंक्तियों की प्रतिलिपि बनाना चाहते हैं, स्क्रीनशॉट देखें:
4। तब दबायें OK बटन, दूसरे प्रॉम्प्ट बॉक्स में, दूसरी शीट में एक सेल का चयन करें जहां आप परिणाम आउटपुट करना चाहते हैं, स्क्रीनशॉट देखें:
5। और फिर क्लिक करें OK बटन, अब, आज की तारीख वाली पंक्तियों को एक ही बार में नई शीट में चिपका दिया जाता है, स्क्रीनशॉट देखें:
यदि दिनांक आज से अधिक है तो पंक्तियों की प्रतिलिपि बनाएँ और दूसरी शीट पर चिपकाएँ
उन पंक्तियों को कॉपी और पेस्ट करने के लिए जो तारीख आज से अधिक या उसके बराबर है, उदाहरण के लिए, यदि तारीख आज से 5 दिनों के बराबर या उससे अधिक है, तो पंक्तियों को कॉपी करके किसी अन्य शीट पर पेस्ट करें।
निम्नलिखित VBA कोड आपके लिए लाभदायक हो सकता है:
1. दबाए रखें ALT + F11 कुंजी को खोलने के लिए अनुप्रयोगों के लिए माइक्रोसॉफ्ट विज़ुअल बेसिक खिड़की.
2। क्लिक करें सम्मिलित करें > मॉड्यूल, और मॉड्यूल विंडो में निम्नलिखित कोड पेस्ट करें।
वीबीए कोड: यदि तारीख आज से अधिक है तो पंक्तियों को कॉपी और पेस्ट करें:
Sub CopyRow()
'Updateby Extentoffice
Dim xRgS As Range, xRgD As Range, xCell As Range
Dim I As Long, xCol As Long, J As Long
Dim xVal As Variant
On Error Resume Next
Set xRgS = Application.InputBox("Please select the date column:", "KuTools For Excel", Selection.Address, , , , , 8)
If xRgS Is Nothing Then Exit Sub
Set xRgD = Application.InputBox("Please select a destination cell:", "KuTools For Excel", , , , , , 8)
If xRgD Is Nothing Then Exit Sub
xCol = xRgS.Rows.Count
Set xRgS = xRgS(1)
Application.CutCopyMode = False
J = 0
For I = 1 To xCol
Set xCell = xRgS.Offset(I - 1, 0)
xVal = xCell.Value
If TypeName(xVal) = "Date" And (xVal <> "") And (xVal >= Date And (xVal < Date + 5)) Then
xCell.EntireRow.Copy xRgD.Offset(J, 0)
J = J + 1
End If
Next
Application.CutCopyMode = True
End Sub
नोट: उपरोक्त कोड में, आप मानदंड बदल सकते हैं, जैसे आज से कम या आपको जितने दिनों की आवश्यकता है यदि टाइपनेम(xVal) = "दिनांक" और (xVal <> "") और (xVal >= दिनांक और (xVal < दिनांक + 5)) तो स्क्रिप्ट कोड.
3। फिर दबायें F5 इस कोड को चलाने के लिए कुंजी, प्रॉम्प्ट बॉक्स में, कृपया उस डेटा कॉलम का चयन करें जिसे आप उपयोग करना चाहते हैं, स्क्रीनशॉट देखें:
4। तब दबायें OK बटन, दूसरे प्रॉम्प्ट बॉक्स में, दूसरी शीट में एक सेल का चयन करें जहां आप परिणाम आउटपुट करना चाहते हैं, स्क्रीनशॉट देखें:
5। दबाएं OK बटन, अब, वे पंक्तियाँ जिनकी तारीख आज से 5 दिनों के बराबर या उससे अधिक है, को कॉपी करके नई शीट में चिपका दिया गया है जैसा कि स्क्रीनशॉट में दिखाया गया है:
सर्वोत्तम कार्यालय उत्पादकता उपकरण
एक्सेल के लिए कुटूल के साथ अपने एक्सेल कौशल को सुपरचार्ज करें, और पहले जैसी दक्षता का अनुभव करें। एक्सेल के लिए कुटूल उत्पादकता बढ़ाने और समय बचाने के लिए 300 से अधिक उन्नत सुविधाएँ प्रदान करता है। वह सुविधा प्राप्त करने के लिए यहां क्लिक करें जिसकी आपको सबसे अधिक आवश्यकता है...
ऑफिस टैब ऑफिस में टैब्ड इंटरफ़ेस लाता है, और आपके काम को बहुत आसान बनाता है
- Word, Excel, PowerPoint में टैब्ड संपादन और रीडिंग सक्षम करें, प्रकाशक, एक्सेस, विसियो और प्रोजेक्ट।
- नई विंडो के बजाय एक ही विंडो के नए टैब में एकाधिक दस्तावेज़ खोलें और बनाएं।
- आपकी उत्पादकता 50% बढ़ जाती है, और आपके लिए हर दिन सैकड़ों माउस क्लिक कम हो जाते हैं!
