VBA Συνδυάστε πολλά αρχεία Excel σε ένα βιβλίο εργασίας

Αυτό το σεμινάριο θα σας δείξει πώς να συνδυάσετε πολλά αρχεία Excel σε ένα βιβλίο εργασίας στο VBA

Η δημιουργία ενός ενιαίου βιβλίου εργασίας από έναν αριθμό βιβλίων εργασίας χρησιμοποιώντας VBA απαιτεί μια σειρά από βήματα που πρέπει να ακολουθηθούν.

• Πρέπει να επιλέξετε τα βιβλία εργασίας από τα οποία θέλετε τα δεδομένα προέλευσης - τα αρχεία προέλευσης.
• Πρέπει να επιλέξετε ή να δημιουργήσετε το βιβλίο εργασίας στο οποίο θέλετε να βάλετε τα δεδομένα - το αρχείο προορισμού.
• Πρέπει να επιλέξετε τα φύλλα από τα αρχεία προέλευσης που χρειάζεστε.
• Πρέπει να πείτε τον κωδικό που θα τοποθετήσετε τα δεδομένα στο αρχείο προορισμού.

Συνδυάζοντας όλα τα φύλλα από όλα τα ανοιχτά βιβλία εργασίας σε ένα νέο βιβλίο εργασίας ως μεμονωμένα φύλλα

Στον παρακάτω κώδικα, τα αρχεία που χρειάζεστε για να αντιγράψετε τις πληροφορίες πρέπει να είναι ανοικτά, καθώς το Excel θα περιηγηθεί στα ανοιχτά αρχεία και θα αντιγράψει τις πληροφορίες σε ένα νέο βιβλίο εργασίας. Ο κωδικός τοποθετείται στο Personal Macro Workbook.

Αυτά τα αρχεία είναι τα ΜΟΝΟ αρχεία του Excel που πρέπει να είναι ανοιχτά.

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647

Sub CombineMultipleFiles ()Στο Σφάλμα GoTo ε«δηλώστε μεταβλητές για να συγκρατήσετε τα απαιτούμενα αντικείμεναDim wbDestination As WorkbookDim wbSource As WorkbookDim wsSource As WorksheetDim wb Ως βιβλίο εργασίαςDim sh ως φύλλο εργασίαςDim strSheetName As StringDim strDestName As String«Απενεργοποιήστε την ενημέρωση οθόνης για να επιταχύνετε τα πράγματαApplication.ScreenUpdating = Λάθος«πρώτα δημιουργήστε νέο βιβλίο εργασίας προορισμούΟρισμός wbDestination = Workbooks.Add«λάβετε το όνομα του νέου βιβλίου εργασίας, ώστε να το εξαιρέσετε από τον παρακάτω βρόχοstrDestName = wbDestination.Name«τώρα κάντε ένα βρόχο σε κάθε ένα από τα βιβλία εργασίας ανοιχτά για να λάβετε τα δεδομένα, αλλά εξαιρέστε το νέο σας βιβλίο ή το προσωπικό βιβλίο μακροεντολής εργασίαςΓια κάθε wb σε εφαρμογή. Βιβλία εργασίαςΕάν wb.Name strDestName And wb.Name "PERSONAL.XLSB" ΤότεΟρίστε wbSource = wbΓια κάθε sh In wbSource.Worksheetssh. Αντιγραφή μετά: = Τετράδια εργασίας (strDestName). Φύλλα (1)Επόμενο shΤέλος εανΕπόμενο wb«τώρα κλείστε όλα τα ανοιχτά αρχεία εκτός από το νέο αρχείο και το προσωπικό βιβλίο μακροεντολής εργασίας.Για κάθε wb σε εφαρμογή. Βιβλία εργασίαςΕάν wb.Name strDestName And wb.Name "PERSONAL.XLSB" Τότεwb. Κλείσιμο ΛάθοςΤέλος εανΕπόμενο wb«αφαιρέστε το φύλλο ένα από το βιβλίο εργασίας προορισμούApplication.DisplayAlerts = ΛάθοςΦύλλα ("Φύλλο1"). ΔιαγραφήApplication.DisplayAlerts = True«καθαρίστε τα αντικείμενα για να απελευθερώσετε τη μνήμηΟρισμός wbDestination = ΤίποταΟρισμός wbSource = ΤίποταΟρισμός wsSource = ΤίποταΡύθμιση wb = Τίποτα«ενεργοποιήστε την ενημέρωση οθόνης όταν ολοκληρωθείApplication.ScreenUpdating = ΛάθοςΈξοδος Subε:MsgBox Err.DescriptionΤέλος υπο

Κάντε κλικ στο παράθυρο διαλόγου Μακροεντολή για να εκτελέσετε τη διαδικασία από την οθόνη του Excel.

Το συνδυασμένο αρχείο σας θα εμφανιστεί τώρα.

Αυτός ο κώδικας έχει κυκλωθεί σε κάθε αρχείο και έχει αντιγράψει το φύλλο σε ένα νέο αρχείο. Εάν κάποιο από τα αρχεία σας έχει περισσότερα από ένα φύλλα - θα αντιγράψει και αυτά - συμπεριλαμβανομένων των φύλλων χωρίς τίποτα πάνω τους!

Συνδυασμός όλων των φύλλων από όλα τα ανοιχτά βιβλία εργασίας σε ένα φύλλο εργασίας σε ένα νέο βιβλίο εργασίας

Η παρακάτω διαδικασία συνδυάζει τις πληροφορίες από όλα τα φύλλα σε όλα τα ανοιχτά βιβλία εργασίας σε ένα φύλλο εργασίας σε ένα νέο βιβλίο εργασίας που δημιουργείται.

Οι πληροφορίες από κάθε φύλλο επικολλούνται στο φύλλο προορισμού στην τελευταία κατεχόμενη σειρά στο φύλλο εργασίας.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869

Sub CombineMultipleSheets ()Στο Σφάλμα GoTo ε«δηλώστε μεταβλητές για να συγκρατήσετε τα απαιτούμενα αντικείμεναDim wbDestination As WorkbookDim wbSource As WorkbookDim wsDestination As WorksheetDim wb Ως βιβλίο εργασίαςDim sh ως φύλλο εργασίαςDim strSheetName As StringDim strDestName As StringDim iRws ως ακέραιοςDim iCols ως ακέραιοςDim totRws As IntegerDim strEndRng As StringDim rngΠηγή ως εύρος«Απενεργοποιήστε την ενημέρωση οθόνης για να επιταχύνετε τα πράγματαApplication.ScreenUpdating = Λάθος«πρώτα δημιουργήστε νέο βιβλίο εργασίας προορισμούΟρισμός wbDestination = Workbooks.Add«λάβετε το όνομα του νέου βιβλίου εργασίας, ώστε να το εξαιρέσετε από τον παρακάτω βρόχοstrDestName = wbDestination.Name"τώρα βρόχο σε κάθε ένα από τα βιβλία εργασίας ανοιχτό για να λάβετε τα δεδομέναΓια κάθε wb σε εφαρμογή. Βιβλία εργασίαςΕάν wb.Name strDestName And wb.Name "PERSONAL.XLSB" ΤότεΟρίστε wbSource = wbΓια κάθε sh In wbSource.Worksheets"λάβετε τον αριθμό των γραμμών και των στηλών στο φύλλοsh. ΕνεργοποιήστεActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). ΕνεργοποίησηiRws = ActiveCell.RowiCols = ActiveCell.Column"ορίστε το εύρος του τελευταίου κελιού στο φύλλοstrEndRng = sh.Cells (iRws, iCols). Διεύθυνση«ρυθμίστε το εύρος πηγής για αντιγραφήΟρισμός rngSource = sh.Range ("A1:" & strEndRng)«βρείτε την τελευταία σειρά στο φύλλο προορισμούwbDestination.ActivateΟρισμός wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell). ΕπιλέξτεtotRws = ActiveCell.Row«ελέγξτε αν υπάρχουν αρκετές σειρές για να επικολλήσετε τα δεδομέναΕάν totRws + rngSource.Rows.Count> wsDestination.Rows.Count Στη συνέχειαMsgBox "Δεν υπάρχουν αρκετές σειρές για να τοποθετήσετε τα δεδομένα στο φύλλο εργασίας ενοποίησης."Πηγαίνετε εΤέλος εαν"προσθέστε μια σειρά για επικόλληση στην επόμενη σειρά προς τα κάτωΑν totRws 1 Τότε totRws = totRws + 1rngSource.Copy Προορισμός: = wsDestination.Range ("A" & totRws)Επόμενο shΤέλος εανΕπόμενο wb«τώρα κλείστε όλα τα ανοιχτά αρχεία εκτός από αυτό που θέλετεΓια κάθε wb σε εφαρμογή. Βιβλία εργασίαςΕάν wb.Name strDestName And wb.Name "PERSONAL.XLSB" Τότεwb. Κλείσιμο ΛάθοςΤέλος εανΕπόμενο wb«καθαρίστε τα αντικείμενα για να απελευθερώσετε τη μνήμηΟρισμός wbDestination = ΤίποταΟρισμός wbSource = ΤίποταΟρισμός wsDestination = ΤίποταΟρισμός rngSource = ΤίποταΡύθμιση wb = Τίποτα«ενεργοποιήστε την ενημέρωση οθόνης όταν ολοκληρωθείApplication.ScreenUpdating = ΛάθοςΈξοδος Subε:MsgBox Err.DescriptionΤέλος υπο

Συνδυασμός όλων των φύλλων από όλα τα ανοιχτά βιβλία εργασίας σε ένα φύλλο εργασίας σε ένα ενεργό βιβλίο εργασίας

Εάν θέλετε να φέρετε τις πληροφορίες από όλα τα άλλα ανοιχτά βιβλία εργασίας σε αυτό στο οποίο εργάζεστε αυτήν τη στιγμή, μπορείτε να χρησιμοποιήσετε αυτόν τον κωδικό παρακάτω.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081

Sub CombineMultipleSheetsToExisting ()Στο Σφάλμα GoTo ε«δηλώστε μεταβλητές για να συγκρατήσετε τα απαιτούμενα αντικείμεναDim wbDestination As WorkbookDim wbSource As WorkbookDim wsDestination As WorksheetDim wb Ως βιβλίο εργασίαςDim sh ως φύλλο εργασίαςDim strSheetName As StringDim strDestName As StringDim iRws ως ακέραιοςDim iCols ως ακέραιοςDim totRws As IntegerDim rngEnd As StringDim rngΠηγή ως εύρος«ορίστε το ενεργό αντικείμενο του βιβλίου εργασίας για το βιβλίο προορισμούΟρισμός wbDestination = ActiveWorkbook"λάβετε το όνομα του ενεργού αρχείουstrDestName = wbDestination.Name«Απενεργοποιήστε την ενημέρωση οθόνης για να επιταχύνετε τα πράγματαApplication.ScreenUpdating = Λάθος«πρώτα δημιουργήστε νέο φύλλο εργασίας προορισμού στο ενεργό βιβλίο εργασίας σαςApplication.DisplayAlerts = Λάθοςσυνέχιση του επόμενου σφάλματος σε περίπτωση φύλλου υπόθεσης δεν υπάρχειΣτο Σφάλμα Συνέχιση ΕπόμενοActiveWorkbook.Sheets ("Consolidation"). Delete«επαναφέρετε την παγίδα σφάλματος για να μεταβείτε στην παγίδα σφάλματος στο τέλοςΣτο Σφάλμα GoTo εApplication.DisplayAlerts = True"προσθέστε ένα νέο φύλλο στο βιβλίο εργασίαςΜε το ActiveWorkbookΟρισμός wsDestination = .Sheets.Add (After: =. Sheets (.Sheets.Count))wsDestination.Name = "Ενοποίηση"Τέλος με"τώρα βρόχο σε κάθε ένα από τα βιβλία εργασίας ανοιχτό για να λάβετε τα δεδομέναΓια κάθε wb σε εφαρμογή. Βιβλία εργασίαςΕάν wb.Name strDestName And wb.Name "PERSONAL.XLSB" ΤότεΟρίστε wbSource = wbΓια κάθε sh In wbSource.Worksheets"λάβετε τον αριθμό των σειρών στο φύλλοsh. ΕνεργοποιήστεActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). ΕνεργοποίησηiRws = ActiveCell.RowiCols = ActiveCell.ColumnrngEnd = sh.Cells (iRws, iCols). ΔιεύθυνσηΟρισμός rngSource = sh.Range ("A1:" & rngEnd)«βρείτε την τελευταία σειρά στο φύλλο προορισμούwbDestination.ActivateΟρισμός wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell). ΕπιλέξτεtotRws = ActiveCell.Row«ελέγξτε αν υπάρχουν αρκετές σειρές για να επικολλήσετε τα δεδομέναΕάν totRws + rngSource.Rows.Count> wsDestination.Rows.Count Στη συνέχειαMsgBox "Δεν υπάρχουν αρκετές σειρές για να τοποθετήσετε τα δεδομένα στο φύλλο εργασίας ενοποίησης."Πηγαίνετε εΤέλος εαν"προσθέστε μια σειρά για επικόλληση στην επόμενη σειρά προς τα κάτω, εάν δεν είστε στη σειρά 1Αν totRws 1 Τότε totRws = totRws + 1rngSource.Copy Προορισμός: = wsDestination.Range ("A" & totRws)Επόμενο shΤέλος εανΕπόμενο wb«τώρα κλείστε όλα τα ανοιχτά αρχεία εκτός από αυτό που θέλετεΓια κάθε wb σε εφαρμογή. Βιβλία εργασίαςΕάν wb.Name strDestName And wb.Name "PERSONAL.XLSB" Τότεwb. Κλείσιμο ΛάθοςΤέλος εανΕπόμενο wb«καθαρίστε τα αντικείμενα για να απελευθερώσετε τη μνήμηΟρισμός wbDestination = ΤίποταΟρισμός wbSource = ΤίποταΟρισμός wsDestination = ΤίποταΟρισμός rngSource = ΤίποταΡύθμιση wb = Τίποτα«ενεργοποιήστε την ενημέρωση οθόνης όταν ολοκληρωθείApplication.ScreenUpdating = ΛάθοςΈξοδος Subε:MsgBox Err.DescriptionΤέλος υπο