[VBA] Αντιγραφή πολλαπλών φύλλων

[othonas]

Καλησπερα εχω τον παρακατω module το οποιο αντιγραφει απο ορισμενα φυλλα συγκεκριμενη περιοχη κελιων στο ενεργο φυλλο (αν το διαβαζω σωστα ) . Θα ηθελα να μου πειτε αν γινεται αυτα τα φυλλα να αντιγραφονται σε καποιο συγκεκριμενο με το ονομα π.χ. Γιωργος .Ευχαριστω οσους απαντησουν.
κωδικας:
Sub SummurizeSheets()
Dim ws As Worksheet
Dim x As Integer

For x = 9 To ActiveWorkbook.Sheets.Count
ActiveWorkbook.Sheets(x).Range("O42:AF83").Copy
ActiveSheet.Paste Range("A65536").End(xlUp).Offset(1, 0)
Next
End Sub

[Thanosp]

Καλησπέρα
Η ρουτίνα αντιγράφει μια περιοχή o42:af83 Φύλλων από το (x=9) sheet9 μέχρι το τελευταίο, στο φύλλο από όπου γίνεται η κλήση της ρουτίνας πχ αν το κουμπί κλήσης είναι στο φύλλο Γιώργος, θα προστεθούν σ'αυτό.
θανάσης

[othonas]

Ευχαριστω για την βοηθεια αλλα μαλλον δεν εξηγω σωστα .Οπως τα λες ειναι με την διαφορα οτι η ρουτινα δεν ειναι στο φυλλο Γιωργος αλλα στο φυλλο1.Γινεται απο το φυλλο1 η ρουτινα να τα μεταφερει στο φυλλο Γιωργος? Ευχαριστω

[Tasos]

Καλησπέρα!

Αγαπητέ φίλε δοκίμασε τον παρακάτω κώδικα:

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

Φιλικά

Τάσος

[othonas]

Καταπληκτικο!!!!!!!!!!
Σας Ευχαριστω Ολους