Excel Files Concatenate

[papazaf]

παιδια εχω καμια 100 excel τα οποια θελω να τα κανω copy paste σε ενα (που να περιεχει τα περιεχομενα και των 100)

εχει κανεις καμια ιδεα?

[UserXP]

>
Sub DoCopyPaste()
Dim aWBook As Workbook, i As Long
Const MinNum = 1
Const MaxNum = 1
Const FixedFullFileName = "c:\file"

On Local Error Resume Next

For i = MinNum To MaxNum
   Set aWBook = Application.Workbooks.Open(FixedFullFileName & Trim(Str(i)) & ".xls")
   If Err = 0 Then
       aWBook.ActiveSheet.Range("A1", aWBook.ActiveSheet.Range("A1").SpecialCells(xlLastCell)).Copy
       ThisWorkbook.ActiveSheet.Paste ThisWorkbook.ActiveSheet.Range("A" & Trim(Str(ThisWorkbook.ActiveSheet.Range("A1").SpecialCells(xlLastCell).Row + 1)))
       ThisWorkbook.ActiveSheet.Range("A1").Copy
       aWBook.Close
   Else
       Err.Clear
       MsgBox "Can not open file number " & i
   End If
Next i

End Sub

 

Προϋποθέσεις:

<> Κάνε paste το κώδικα στο excel αρχείο που θα περιέχει και τα 100 αρχεία (στο code module του ThisWorkbook)

<> Τα αρχεία είναι της μορφής "<κάποια σταθερά (ίδια) γράμματα><αυξανόμενος αριθμός>.xls". Π.χ. file1.xls, file2.xls, file3.xls, ...

<> Μέσα στον κώδικα δώσε στα MinNum και MaxNum τις σωστές τιμές, δηλ. το μικρότερο και μεγαλύτερο νούμερο στην αρίθμηση των αρχείων

<> Μέσα στον κώδικα δώσε στο FixedFullFileName το πλήρες path που βρίσκονται τα αρχεία σου, μαζί με τα πρώτα σταθερά γράμματα. Π.χ. "c:\My Excel\Many files\file"

[UserXP]

>
Sub DoCopyPaste2()
Dim aWBook As Workbook, i As Long, aName As String
Const PathOfFiles = "c:\My Excel\Many files"

On Local Error Resume Next

aName = Dir(PathOfFiles & "\*.xls")
Do While aName <> ""
   Set aWBook = Application.Workbooks.Open(PathOfFiles & "\" & aName)
   If Err = 0 Then
       aWBook.ActiveSheet.Range("A1", aWBook.ActiveSheet.Range("A1").SpecialCells(xlLastCell)).Copy
       ThisWorkbook.ActiveSheet.Paste ThisWorkbook.ActiveSheet.Range("A" & Trim(Str(ThisWorkbook.ActiveSheet.Range("A1").SpecialCells(xlLastCell).Row + 1)))
       ThisWorkbook.ActiveSheet.Range("A1").Copy
       aWBook.Close
   Else
       Err.Clear
       MsgBox "Can not open file " & aName
   End If
   aName = Dir
Loop

End Sub

 

Σκέφθηκα κάτι καλύτερο.

<> Τοποθέτησε όλα τα αρχεία που θες σε ένα δικό τους folder (υποθέτω ότι όλα έχουν κατάληξη xls).

<> Κάνε paste το κώδικα στο excel αρχείο που θα περιέχει και τα 100 αρχεία (στο code module του ThisWorkbook)

<> Μέσα στον κώδικα δώσε στο PathOfFiles τη πλήρες διαδρομή του παραπάνω folder

 

 

Ξέχασα να πω ότι η Sub κάνει copy όλα τα περιεχόμενα του ActiveSheet για κάθε ένα από τα αρχικά αρχεία και όχι όλα τα sheets που μπορεί να έχει το κάθε αρχείο.

[papazaf]

σε ευχαριστω πολυ