Συγχώνευση βιβλίων excel μέσω Visual basic

[Χάρης Μυλωνίδης]

Καλησπέρα βρήκα αυτόν τον κώδικα σε VBasic που μετατρέπει τα workbooks σε ένα.

Στο κάθε workbook έχω 2 sheets ένα dataentry και ένα Δελτίο Πωλήσεων

Το πρόβλημα μου είναι:

1ον Θέλω να εμφανίζεται μόνο το φύλλο Δελτίο Πωλήσεων όχι το dataentry

2ον Να εμφανίζεται σε ένα φύλλο όλα τα ονόματα των πωλήσεων, δηλ να αντιγράφει απο τα workbooks συγκεκριμένο sheet και συγκεκριμένο πεδίο πχ α8:Ν20 μέσα σε αυτό το πεδίο είναι τα ονόματα και τα ποσά.

 

Ελπίζω να έγινα κατανοητός, ο κώδικας είναι ο παρακάτω.

Sub GetSheets()
Path = "C:\Users\dt\Desktop\dt kte\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

ευχαριστώ προκαταβολικά σε όσους θα απαντήσουν

βρήκα και έναν άλλο κώδικα εδώ, απλά θα ήθελα τη βοήθεια σας.

[nucleus]

Για το 1.Πρέπει να αλλαχτεί το παρακάτω σημείο

For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet

σε

For Each Sheet In ActiveWorkbook.Sheets
If Sheet.Name == "Δελτίο Πωλήσεων"
  Sheet.Copy After:=ThisWorkbook.Sheets(1)
End If
Next Sheet

Για κάθε sheet στο ActiveWorkbook αντίγραψε το μόνο αν το όνομα του είναι "Δελτίο Πωλήσεων"

 

Για το 2. Από το δεύτερο Link που πόσταρες

' Add a worksheet with the name "RDBMergeSheet"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "RDBMergeSheet"

Το παραπάνω είναι ο κώδικας για να προστέσεις ένα Worksheet με όνομα RDBMergeSheet

 

τι ακριβώς θες να βάλει εκει μέσα όμως? Α8:Ν20 σημαίνει τις γραμμές 8 εώς 20 από τα columns A εώς Ν?

[Χάρης Μυλωνίδης]

 

Για το 1.Πρέπει να αλλαχτεί το παρακάτω σημείο

For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet

σε

For Each Sheet In ActiveWorkbook.Sheets
If Sheet.Name == "Δελτίο Πωλήσεων"
  Sheet.Copy After:=ThisWorkbook.Sheets(1)
End If
Next Sheet

Για κάθε sheet στο ActiveWorkbook αντίγραψε το μόνο αν το όνομα του είναι "Δελτίο Πωλήσεων"

 

Για το 2. Από το δεύτερο Link που πόσταρες

' Add a worksheet with the name "RDBMergeSheet"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "RDBMergeSheet"

Το παραπάνω είναι ο κώδικας για να προστέσεις ένα Worksheet με όνομα RDBMergeSheet

 

τι ακριβώς θες να βάλει εκει μέσα όμως? Α8:Ν20 σημαίνει τις γραμμές 8 εώς 20 από τα columns A εώς Ν?

 

αυτό που θέλω να κάνω είναι να αντιγράψω απο το πεδίο Α8:Ν20 αυτό τα δεδομένα που έχει και είναι κείμενο δηλ ονομ/μο και τιμές δηλ ποσά.

 

Για να καταλάβεις θέλω να πάρει όλα τα *.xlsx και να τα αντιγράψει σε ένα workbook σε ένα sheet και να περιέχει μέσα το sheet αυτό τις ετικέτες δηλ ονομα,επίθετο,ΦΠΑ,Προκαταβολή,Υπόλοιπο,κτλ μαζί με τις τιμές αλλά να μην επαναλαμβάνονται οι ετικέτες να γράφει μια φορά τις ετικέτες ονομα,επίθετο,ΦΠΑ κτλ και μετά να αντιγράφει τα δεδομένα απο το πεδίο Α8:Ν20 που είναι ονματεπώνυμα και ποσά δηλ κείμενο και αριθμοί.

 

Για να καταλάβεις πως είναι στημένο το κάθε αρχείο απ το οποίο θέλω να πάρω τα δεδομένα ,δες εδώ ένα δείγμα.

Επεξ/σία 2 Δεκεμβρίου 2014 από Χάρης Μυλωνίδης

[Χάρης Μυλωνίδης]

θέλω να είναι ενοποιημένο σε ένα κώδικα αυτά που λέω. Δηλαδή να κάνει όλα αυτά που λέω σε ένα σκριπτάκι της vbasic

[Χάρης Μυλωνίδης]

κάποιος να με βοηθήσεις στο ερώτημα μου

[Χάρης Μυλωνίδης]

το δοκίμασα και δεν δουλεύει αυτό

For Each Sheet In ActiveWorkbook.Sheets
If Sheet.Name == "Δελτίο Πωλήσεων"
  Sheet.Copy After:=ThisWorkbook.Sheets(1)
End If
Next Sheet

έτσι είναι το σωστό

For Each Sheet In ActiveWorkbook.Sheets
If Sheet.Name = "Δελτίο Πωλήσεων" then
  Sheet.Copy After:=ThisWorkbook.Sheets(1)
End If
Next Sheet

[Χάρης Μυλωνίδης]

προσπαθώ να εκτελέσω τον παρακάτω κώδικα και μου βγάζει sub or function not defined

τι πρέπει να κάνω

[nucleus]

Δεν έχεις βάλει μέσα στο module τις παρακάτω συναρτήσεις

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function

[Χάρης Μυλωνίδης]

οκ ευχαριστώ

και κάτι τελευταίο τι μετατροπές θα πρέπει να κάνω στον κώδικα ώστε να αντιγράφει ένα συγκεκριμένο πεδίο πχ Α8:Ν30

θέλω να αντιγράφει αυτό το πεδίο χωρίς τα υπόλοιπα που υπάρχουν μέσα στα φύλλα.

Αυτό πως το κάνω μήπως ξέρεις;

[nucleus]

http://msdn.microsoft.com/en-us/library/office/ff838238%28v=office.15%29.aspx

 

Διάβασε εδώ μπας και μπορέσεις να βγάλεις άκρη.

 

Για δοκίμασε να αλλάξεις το Startrow από 2 σε 8.

 

Υπάρχουν δεδομένα κάτω από την 30 γραμμή? Αν όχι εκεί θα τερματίσει αν ναι τότε πρέπει να αλλάξεις και το τελευταίο row που είναι η μεταβλητή shLast. Ίσως αν το κάνεις shLast = 30 αντί για shLast = LastRow(sh). Για δοκίμασε.

[Χάρης Μυλωνίδης]

οκ θα το κοιτάξω ευχαριστώ