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

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [VBA] Αντιγραφή πολλαπλών φύλλων (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/2528-antigrafi-pollaplon-fillon.html)

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

Καλησπερα εχω τον παρακατω 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

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

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

Καλησπέρα!

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

Κώδικας:

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

Φιλικά

Τάσος

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