
20-05-13, 17:38
|
 | Διαχειριστής Όνομα: Τάσος Φιλοξενιδης Έκδοση λογισμικού Office: Ms-Office 365 Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική | | Εγγραφή: 21-10-2009
Μηνύματα: 2.035
| |
Καλησπέρα!
Αγαπητέ φίλε δοκίμασε τον παρακάτω κώδικα: Κώδικας: Option Explicit
Sub SummarizeWorksheets()
Dim i As Integer
Dim SummarySheet As Worksheet 'Δήλωση του φύλλου όπου θα συνγκεντρωθούν τα δεδομένα
Dim SrcRange As Range 'Δήλωση της περιοχής-πηγής
Dim DestRange As Range 'Δήλωση της περιοχής-προορισμού
Set SummarySheet = Worksheets("Summary") ' Είναι πιο σωστό να χρησιμοποιείται το κωδικό όνομα
' του φύλλου όπως αυτό εμφανίσεται στον Project Explorer
' πχ,: Set SummarySheet = Sheet10
With Application
'στις επόμενες τρεις γραμμές επιταχύνεται η ροή του κώδικα
.ScreenUpdating = False 'Παρόλο που δεν μεταφερόμαστε σε άλλο σημείο του βιβλίου,
'η απενεργοποίηση ανανέωσης της οθόνης επιταχύνει τον κώδικα
.Calculation = xlCalculationManual ' Διακοπή αυτόματου υπολογισμού
.EnableEvents = False ' Απενεργοποίηση τυχόν συμβάντων στην εφαρμογή
For i = 9 To Worksheets.Count ' Προσοχή Worksheets.Count Όχι Sheets.Count
' Η έκφραση Sheets.Count περιλαμβάνει τον αριθμό όλων
' των φύλλων ακόμα και αν αυτά δεν είναι φύλλα εργασίας
' (πχ. γραφήματα, συγκεντρωτικοί πίνακες κλπ.)
Set SrcRange = Worksheets(i).Range("O42:AF83")
Set DestRange = SummarySheet.Range("A" & Rows.Count).End(xlUp).Offset(1) _
.Resize(SrcRange.Rows.Count, SrcRange.Columns.Count)
DestRange.Value = SrcRange.Value ' Η γραμμή αυτή κάνει το ζητούμενο.
' Δεν χρειάζεται αντιγραφή - επικόλληση.
' H αντιγραφή - επικόλληση προορίζεται για
' να χρησιμοποιηθεί από τον χρήστη και όχι
' από τον κώδικα VBA
Next
'Επαναφορά των ρυθμίσεων της εφαρμογής
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub
Φιλικά
Τάσος
__________________ Ms-Office Development Team Ανάπτυξη επαγγελματικών εφαρμογών |