Εμφάνιση ενός μόνο μηνύματος
  #4  
Παλιά 20-05-13, 17:38
Το avatar του χρήστη Tasos
Tasos Ο χρήστης Tasos δεν είναι συνδεδεμένος
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού 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
Ανάπτυξη επαγγελματικών εφαρμογών
Απάντηση με παράθεση