विषय - सूची
- सभी खुली कार्यपुस्तिकाओं से सभी पत्रक को एक नई कार्यपुस्तिका में व्यक्तिगत पत्रक के रूप में संयोजित करना
- सभी खुली कार्यपुस्तिकाओं से सभी पत्रक को एक नई कार्यपुस्तिका में एकल कार्यपत्रक में संयोजित करना
- एक सक्रिय कार्यपुस्तिका में सभी खुली कार्यपुस्तिकाओं से सभी पत्रक को एकल कार्यपत्रक में संयोजित करना
यह ट्यूटोरियल आपको दिखाएगा कि VBA में एक से अधिक एक्सेल फ़ाइलों को एक कार्यपुस्तिका में कैसे संयोजित किया जाए
VBA का उपयोग करके कई कार्यपुस्तिका से एकल कार्यपुस्तिका बनाने के लिए कई चरणों का पालन करना आवश्यक है।
- आपको उन कार्यपुस्तिकाओं का चयन करना होगा जिनसे आप स्रोत डेटा चाहते हैं - स्रोत फ़ाइलें।
- आपको उस कार्यपुस्तिका को चुनने या बनाने की आवश्यकता है जिसमें आप डेटा डालना चाहते हैं - गंतव्य फ़ाइल।
- आपको उन सोर्स फाइलों से शीट्स का चयन करना होगा जिनकी आपको आवश्यकता है।
- आपको उस कोड को बताना होगा जहां डेटा को गंतव्य फ़ाइल में रखा जाए।
सभी खुली कार्यपुस्तिकाओं से सभी पत्रक को एक नई कार्यपुस्तिका में व्यक्तिगत पत्रक के रूप में संयोजित करना
नीचे दिए गए कोड में, जिन फाइलों से आपको जानकारी की प्रतिलिपि बनाने की आवश्यकता है, उन्हें खोलने की आवश्यकता है क्योंकि एक्सेल खुली फाइलों के माध्यम से लूप करेगा और जानकारी को एक नई कार्यपुस्तिका में कॉपी करेगा। कोड को पर्सनल मैक्रो वर्कबुक में रखा गया है।
ये फ़ाइलें केवल एक्सेल फ़ाइलें हैं जो खुली होनी चाहिए।
| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647 | सब कम्बाइनमल्टीपलफाइल्स ()एरर गोटो एह पर'आवश्यक वस्तुओं को रखने के लिए चर घोषित करें'कार्यपुस्तिका के रूप में मंद wbगंतव्यकार्यपुस्तिका के रूप में मंद wbSourceवर्कशीट के रूप में डिम wsSourceकार्यपुस्तिका के रूप में मंद wbवर्कशीट के रूप में मंद शस्ट्रिंग के रूप में मंद strSheetNameस्ट्रिंग के रूप में मंद strDestName'चीजों को गति देने के लिए स्क्रीन अपडेट करना बंद करें'एप्लिकेशन.स्क्रीनअपडेटिंग = गलत'पहले नई गंतव्य कार्यपुस्तिका बनाएं'wbDestination = कार्यपुस्तिकाएँ सेट करें। जोड़ें'नई कार्यपुस्तिका का नाम प्राप्त करें ताकि आप इसे नीचे दिए गए लूप से बाहर कर देंstrDestName = wbDestination.Name'अब डेटा प्राप्त करने के लिए खुली प्रत्येक कार्यपुस्तिका के माध्यम से लूप करें लेकिन अपनी नई पुस्तक या व्यक्तिगत मैक्रो कार्यपुस्तिका को बाहर करेंअनुप्रयोग में प्रत्येक wb के लिए। कार्यपुस्तिकाएँअगर wb.Name strDestName और wb.Name "PERSONAL.XLSB" तोwbSource = wb . सेट करेंwbSource.Worksheets में प्रत्येक श के लिएsh.Copy after:=Workbooks(strDestName).Sheets(1)अगला शअगर अंतअगला डब्ल्यूबी'अब नई फाइल और पर्सनल मैक्रो वर्कबुक को छोड़कर सभी खुली फाइलों को बंद करें।अनुप्रयोग में प्रत्येक wb के लिए। कार्यपुस्तिकाएँअगर wb.Name strDestName और wb.Name "PERSONAL.XLSB" तोwb.गलत बंद करेंअगर अंतअगला डब्ल्यूबी'गंतव्य कार्यपुस्तिका से शीट एक हटाएं'एप्लिकेशन। डिस्प्ले अलर्ट = गलतपत्रक ("पत्रक 1")। हटाएंएप्लिकेशन.डिस्प्लेअलर्ट्स = ट्रू'स्मृति को मुक्त करने के लिए वस्तुओं को साफ करें'सेट wbDestination = कुछ नहींसेट wbSource = कुछ नहींwsSource सेट करें = कुछ भी नहींडब्ल्यूबी सेट करें = कुछ भी नहीं'पूर्ण होने पर स्क्रीन अपडेट करना चालू करें'एप्लिकेशन.स्क्रीनअपडेटिंग = गलतउप से बाहर निकलेंएह:MsgBox Err.Descriptionअंत उप |
अपनी एक्सेल स्क्रीन से प्रक्रिया को चलाने के लिए मैक्रो डायलॉग बॉक्स पर क्लिक करें।
आपकी संयुक्त फाइल अब प्रदर्शित होगी।
इस कोड ने प्रत्येक फ़ाइल के माध्यम से लूप किया है, और शीट को एक नई फ़ाइल में कॉपी किया है। यदि आपकी किसी भी फाइल में एक से अधिक शीट हैं - तो वह उन्हें भी कॉपी कर लेगी - जिसमें वे शीट भी शामिल हैं जिन पर कुछ भी नहीं है!
सभी खुली कार्यपुस्तिकाओं से सभी पत्रक को एक नई कार्यपुस्तिका में एकल कार्यपत्रक में संयोजित करना
नीचे दी गई प्रक्रिया सभी खुली कार्यपुस्तिकाओं में सभी शीट से जानकारी को एक नई कार्यपुस्तिका में एक एकल कार्यपत्रक में जोड़ती है जो बनाई गई है।
प्रत्येक शीट की जानकारी को वर्कशीट पर अंतिम कब्जे वाली पंक्ति में गंतव्य शीट में चिपकाया जाता है।
| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869 | उप संयोजन एकाधिक पत्रक ()एरर गोटो एह पर'आवश्यक वस्तुओं को रखने के लिए चर घोषित करें'कार्यपुस्तिका के रूप में मंद wbगंतव्यकार्यपुस्तिका के रूप में मंद wbSourceकार्यपत्रक के रूप में मंद wsगंतव्यकार्यपुस्तिका के रूप में मंद wbवर्कशीट के रूप में मंद शस्ट्रिंग के रूप में मंद strSheetNameस्ट्रिंग के रूप में मंद strDestNameपूर्णांक के रूप में मंद iRwsपूर्णांक के रूप में मंद iColsपूर्णांक के रूप में मंद toRwsस्ट्रिंग के रूप में मंद strEndRngरेंज के रूप में मंद आरएनजी स्रोत'चीजों को गति देने के लिए स्क्रीन अपडेट करना बंद करें'एप्लिकेशन.स्क्रीनअपडेटिंग = गलत'पहले नई गंतव्य कार्यपुस्तिका बनाएं'wbDestination = कार्यपुस्तिकाएँ सेट करें। जोड़ें'नई कार्यपुस्तिका का नाम प्राप्त करें ताकि आप इसे नीचे दिए गए लूप से बाहर कर देंstrDestName = wbDestination.Name'अब डेटा प्राप्त करने के लिए खुली प्रत्येक कार्यपुस्तिका के माध्यम से लूप करें'अनुप्रयोग में प्रत्येक wb के लिए। कार्यपुस्तिकाएँअगर wb.Name strDestName और wb.Name "PERSONAL.XLSB" तोwbSource = wb . सेट करेंwbSource.Worksheets में प्रत्येक श के लिए'पत्रक में पंक्तियों और स्तंभों की संख्या प्राप्त करें'श.सक्रिय करेंActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)।सक्रिय करेंiRws = ActiveCell.RowiCols = ActiveCell.Column'पत्रक में अंतिम सेल की सीमा निर्धारित करें'strEndRng = sh.Cells(iRws, iCols).Address'कॉपी करने के लिए स्रोत श्रेणी सेट करें'सेट rngSource = sh.Range("A1:" & strEndRng)'गंतव्य पत्रक में अंतिम पंक्ति खोजेंwbगंतव्य.सक्रिय करेंWsDestination = ActiveSheet सेट करेंwsDestination.Cells.SpecialCells(xlCellTypeLastCell)।चुनेंtotRws = ActiveCell.Row'जांचें कि क्या डेटा पेस्ट करने के लिए पर्याप्त पंक्तियां हैं'अगर totRws + rngSource.Rows.Count > wsDestination.Rows.Count तोMsgBox "डेटा को समेकन कार्यपत्रक में रखने के लिए पर्याप्त पंक्तियाँ नहीं हैं।"जाओ एहअगर अंत'अगली पंक्ति में नीचे चिपकाने के लिए एक पंक्ति जोड़ें'अगर totRws 1 तो totRws = totRws + 1rngSource.Copy Destination:=wsDestination.Range("A" & totRws)अगला शअगर अंतअगला डब्ल्यूबी'अब आप जो चाहते हैं उसे छोड़कर सभी खुली फाइलों को बंद कर दें'अनुप्रयोग में प्रत्येक wb के लिए। कार्यपुस्तिकाएँअगर wb.Name strDestName और wb.Name "PERSONAL.XLSB" तोwb.गलत बंद करेंअगर अंतअगला डब्ल्यूबी'स्मृति को मुक्त करने के लिए वस्तुओं को साफ करें'सेट wbDestination = कुछ नहींसेट wbSource = कुछ नहींसेट wsDestination = कुछ नहींसेट rngSource = कुछ नहींडब्ल्यूबी सेट करें = कुछ भी नहीं'पूर्ण होने पर स्क्रीन अपडेट करना चालू करें'एप्लिकेशन.स्क्रीनअपडेटिंग = गलतउप से बाहर निकलेंएह:MsgBox Err.Descriptionअंत उप |
एक सक्रिय कार्यपुस्तिका में सभी खुली कार्यपुस्तिकाओं से सभी पत्रक को एकल कार्यपत्रक में संयोजित करना
यदि आप अन्य सभी खुली कार्यपुस्तिकाओं की जानकारी को उस कार्यपुस्तिका में लाना चाहते हैं जिसमें आप वर्तमान में काम कर रहे हैं, तो आप नीचे दिए गए इस कोड का उपयोग कर सकते हैं।
| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081 | सब कॉम्बिनेशनमल्टीपलशीट्सटूएक्सिस्टिंग ()एरर गोटो एह पर'आवश्यक वस्तुओं को रखने के लिए चर घोषित करें'कार्यपुस्तिका के रूप में मंद wbगंतव्यकार्यपुस्तिका के रूप में मंद wbSourceकार्यपत्रक के रूप में मंद wsगंतव्यकार्यपुस्तिका के रूप में मंद wbवर्कशीट के रूप में मंद शस्ट्रिंग के रूप में मंद strSheetNameस्ट्रिंग के रूप में मंद strDestNameपूर्णांक के रूप में मंद iRwsपूर्णांक के रूप में मंद iColsपूर्णांक के रूप में मंद toRwsस्ट्रिंग के रूप में मंद rngEndरेंज के रूप में मंद आरएनजी स्रोत'गंतव्य पुस्तक के लिए सक्रिय कार्यपुस्तिका ऑब्जेक्ट सेट करें'wbDestination = ActiveWorkbook सेट करें'सक्रिय फ़ाइल का नाम प्राप्त करें'strDestName = wbDestination.Name'चीजों को गति देने के लिए स्क्रीन अपडेट करना बंद करें'एप्लिकेशन.स्क्रीनअपडेटिंग = गलत'पहले अपनी सक्रिय कार्यपुस्तिका में नई गंतव्य कार्यपत्रक बनाएं'एप्लिकेशन। डिस्प्ले अलर्ट = गलत'यदि शीट मौजूद नहीं है तो अगली त्रुटि फिर से शुरू करें'त्रुटि पर फिर से शुरू करें अगलाActiveWorkbook.Sheets ("समेकन")। हटाएं'त्रुटि जाल को अंत में त्रुटि जाल में जाने के लिए रीसेट करें'एरर गोटो एह परएप्लिकेशन.डिस्प्लेअलर्ट्स = ट्रू'कार्यपुस्तिका में एक नई शीट जोड़ें'सक्रिय कार्यपुस्तिका के साथwsDestination = .Sheets.Add(बाद:=.Sheets(.Sheets.Count)) सेट करेंwsDestination.Name = "समेकन"के साथ समाप्त करना'अब डेटा प्राप्त करने के लिए खुली प्रत्येक कार्यपुस्तिका के माध्यम से लूप करें'अनुप्रयोग में प्रत्येक wb के लिए। कार्यपुस्तिकाएँअगर wb.Name strDestName और wb.Name "PERSONAL.XLSB" तोwbSource = wb . सेट करेंwbSource.Worksheets में प्रत्येक श के लिए'शीट में पंक्तियों की संख्या प्राप्त करें'श.सक्रिय करेंActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).ActivateiRws = ActiveCell.RowiCols = ActiveCell.ColumnrngEnd = sh.Cells(iRws, iCols).Addressसेट rngSource = sh.Range("A1:" & rngEnd)'गंतव्य पत्रक में अंतिम पंक्ति खोजेंwbगंतव्य.सक्रिय करेंWsDestination = ActiveSheet सेट करेंwsDestination.Cells.SpecialCells(xlCellTypeLastCell)।चुनेंtotRws = ActiveCell.Row'जांचें कि क्या डेटा पेस्ट करने के लिए पर्याप्त पंक्तियां हैं'अगर totRws + rngSource.Rows.Count > wsDestination.Rows.Count तोMsgBox "डेटा को समेकन कार्यपत्रक में रखने के लिए पर्याप्त पंक्तियाँ नहीं हैं।"जाओ एहअगर अंत'यदि आप पंक्ति 1 में नहीं हैं तो अगली पंक्ति में नीचे चिपकाने के लिए एक पंक्ति जोड़ें'अगर totRws 1 तो totRws = totRws + 1rngSource.Copy Destination:=wsDestination.Range("A" & totRws)अगला शअगर अंतअगला डब्ल्यूबी'अब आप जो चाहते हैं उसे छोड़कर सभी खुली फाइलों को बंद कर दें'अनुप्रयोग में प्रत्येक wb के लिए। कार्यपुस्तिकाएँअगर wb.Name strDestName और wb.Name "PERSONAL.XLSB" तोwb.गलत बंद करेंअगर अंतअगला डब्ल्यूबी'स्मृति को मुक्त करने के लिए वस्तुओं को साफ करें'सेट wbDestination = कुछ नहींसेट wbSource = कुछ नहींसेट wsDestination = कुछ नहींसेट rngSource = कुछ नहींडब्ल्यूबी सेट करें = कुछ भी नहीं'पूर्ण होने पर स्क्रीन अपडेट करना चालू करें'एप्लिकेशन.स्क्रीनअपडेटिंग = गलतउप से बाहर निकलेंएह:MsgBox Err.Descriptionअंत उप |
