Ανανέωση ιστοσελίδας

[gaz_manos]

Καλημέρα.
Εχω ένα θέμα και δεν ξέρω πως μπορώ να το αντιμετωπίσω.

Έχω ένα αρχείο excel και σε ένα φύλλο έχω ανα 20 γραμμές απο έναν πίνακα.
Το ερώτημα είναι το εξής. Υπάρχει τρόπος να εξάγω αυτούς τους πίνακες σε ξεχωριστά αρχεία excel;
Ευχαριστώ.

[Spirosgr]

Καλησπέρα
Αγαπητέ Μάνο,
Επειδή προφανώς, η λύση θα είναι με κώδικα,
οι πληροφορίες που δίνεις, δεν είναι αρκετές, για να έχουμε σαφή άποψη για το ζητούμενο.
Για παράδειγμα:
Οι πίνακες που αναφέρεις, είναι πραγματικοί πίνακες ή περιοχές;
Σε ποιο σημείο ακριβώς, θα αποθηκεύονται τα αρχεία που θα δημιουργηθούν;
Με ποιο όνομα;
Τι είδους αρχείο θα δημιουργηθεί; (πχ. .xls, .xlsx κλπ)

Σε κάθε περίπτωση ο πιο κάτω γενικός κώδικας,

Sub ReCreateTblNewWb()
    Dim FName As String
    Dim i As Integer

    For i = 1 To Sheet1.ListObjects.Count

        Range("Table" & i & "[#All]").Copy
        Workbooks.Add
        ActiveSheet.Paste
        FName = "testBook" & i
        ActiveWorkbook.SaveAs Filename:=FName & ".xlsx"
        ActiveWindow.Close
        
    Next i
End Sub

δημιουργεί, τόσα αρχεία .xlsx στην επιφάνεια εργασίας, όσοι και οι πίνακες που υπάρχουν, στο Sheet1 του μητρικού βιβλίου.
Το όνομα του νέου αρχείου είναι testBook + ο αριθμός του πίνακα που έχει αντιγραφεί σε αυτό.
Στα νέα αρχεία, κάθε πίνακας, έχει επικολληθεί στο κελί a1.

Οι πίνακες, είναι πραγματικοί πίνακες (ListObjects) και
οι διαστάσεις τους είναι, χ στήλες, ψ γραμμές (αδιάφορο).
Οι πίνακες, πρέπει να έχουν ονομασίες Table1, Table2, Table3, και
η θέση τους μέσα στο φύλλο μπορεί να είναι οπουδήποτε.

[gaz_manos]

Σπύρο καλημέρα.
Σε ευχαριστώ πολύ για την απάντησή σου.
Το αρχείο που έχω και θέλω να διασπάσω δεν είναι με αντικείμενα πίνακες είναι περιοχές.
Υπάρχει τρόπος να γίνει αυτό με περιοχές;
Ευχαριστώ.

[Spirosgr]

Καλημέρα
Στο Sheet1 ενός βιβλίου, έχουμε περιοχές με δεδομένα.
Κάθε περιοχή, αρχίζει από την επόμενη γραμμή, που τελειώνει η προηγούμενη.
Παράδειγμα:
πρώτη: γραμμή 1 - 20
δεύτερη: γραμμή 21 - 40 κοκ

Το πλάτος κάθε περιοχής, είναι αδιάφορο - (ν) στήλες

Οι περιοχές, πρέπει να έχουν κεφαλίδες, στην πρώτη γραμμή τους,
ή να είναι «γεμάτες» με δεδομένα, όσον αφορά τουλάχιστον την πρώτη γραμμή τους.

Sub CreateWBsByRngs()
    Dim sRow As Long
    Dim eRow As Long
    Dim eCol As Long
    Dim fRow As Long
    Dim i As Integer
    Dim FName As String

    sRow = 1
    eRow = 20

    fRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 1 To fRow / 20
        eCol = Sheet1.Cells(sRow, Columns.Count).End(xlToLeft).Column
        Sheet1.Range(Cells(sRow, 1), Cells(eRow, eCol)).Copy
        Workbooks.Add
        ActiveSheet.Paste
        FName = "testBook" & i
        ActiveWorkbook.SaveAs Filename:=FName & ".xlsx"
        ActiveWindow.Close

        sRow = sRow + 20
        eRow = eRow + 20

    Next i
End Sub

Ο κώδικας:
Δημιουργεί, τόσα αρχεία .xlsx στην επιφάνεια εργασίας,
ή όπου έχουμε ορίσει να αποθηκεύονται εξ' ορισμού στον υπολογιστή μας,
όσες και οι περιοχές που υπάρχουν, στο Sheet1 του μητρικού βιβλίου.
Το όνομα του νέου αρχείου είναι testBook + ένας αύξων αριθμός από το 1 έως (χ) - αριθμός περιοχών.
Στα νέα αρχεία, κάθε περιοχή, έχει επικολληθεί στο κελί a1.

[gaz_manos]

Δεν μου δουλεύει. Βγάζει ένα μήνυμα Run-time error'1004'
Method 'Range' of object'_Worksheet' Failed.
Ισως φταίει που στο δικό μου αρχείο η πρώτη γραμμή της κάθε περιοχής έχει μόνο στο πρώτο κελί κείμενο και η καθε επόμενη περιοχή ξεκινάει μετα απο 5 κενές σειρές.
Δεν ξέρω τι να πώ.
Μήπως έχεις κάποια ιδέα;
Ευχαριστώ

[Spirosgr]

Καλησπέρα

Προφανώς έχεις Ελληνικό Office και θα πρέπει να αλλάξεις το Sheet1. στον κώδικα με το ανάλογο κωδικό όνομα φύλλου (πχ Φύλλο1,2...)

Από την άλλη και να τρέξει ο κώδικας, δεν θα έχει σωστό αποτέλεσμα σε αυτό που ζητάς τώρα.
Με τις παραμέτρους που αναφέρω, δουλεύει σίγουρα σωστά.

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

«πίνακες όχι πίνακες περιοχές, ανά 20 γραμμές όχι τώρα με 5 κενά ανάμεσα ή ότι άλλο.»
ώστε να σταματήσω να μαντεύω, και ίσως πάρεις απάντηση.