VBA : Copier tableau dans un autre fichier [RESOLU]

gr12sable

XLDnaute Nouveau
Bonjour,

Je souhaiterai regrouper plusieurs tableau Excel de différents fichier mais de constitutions identique (Nombre de colonne fixe, seul les lignes varient), dans un autre fichier (les un à la suite des autres).

J'ai réalisé une macro mais je bug sur le collage, erreur 1004 taille de destinations, comment fait-on pour coller un tableau ?

Merci.

Code :
Code:
Dim fso As Object, Dossier As Object, NomDossier
Dim Files As Object, File As Object, i, k As Integer
Dim xls As New Excel.Application
Dim FeuilleSource As Excel.Worksheet, FeuilleCible As Excel.Worksheet

Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.getfolder(ThisWorkbook.Path)
    
Set Files = Dossier.Files

If Files.Count <> 0 Then
    For Each File In Files
        If File.Name <> "MasterPA.xlsm" And File.Name <> "~$MasterPA.xlsm" Then

Set FeuilleSource = xls.Workbooks.Open(File.Path).Worksheets("PA")
Set FeuilleCible = ActiveWorkbook.Worksheets("Actions PA")

   
    With FeuilleSource
               Range("A9").Select
               Range(Selection, Selection.End(xlDown)).Select
               Range(Selection, Selection.End(xlToRight)).Select
               Range(Selection, Selection.End(xlToRight)).Select
               Selection.Copy
    End With
    
    With FeuilleCible
               Lg = Sheets("Actions PA").Cells(65536, 2).End(xlUp).Row + 1
                .Range("B" & Lg).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False ', Transpose:=False
    End With

Merci
 
Dernière édition:

Softmama

XLDnaute Accro
Re : VBA : Copier tableau dans un autre fichier

Bonjour,

Un peu dans le flou, mais essaie ceci à la place des 15 dernières lignes de ta macro :

Code:
Lg = Sheets("Actions PA").Cells(65536, 2).End(xlUp).Row + 1
FeuilleSource.Range("A9").Currentregion.Copy
FeuilleCible.Range("B" & Lg).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False , Transpose:=False
 

gr12sable

XLDnaute Nouveau
Re : VBA : Copier tableau dans un autre fichier

Rebonjour,

Avec qq exemple ca devrait être plus simple

J'ai par exemple PA004, PA005, ... ,que je souhaite regrouper les uns en dessous des autres dans MasterPA.
C'est au niveau de la copie que je bloque ca me met toujours une erreur.

Ci-joint des extraits de doc...

Merci
 

Pièces jointes

  • PA0005_test.xlsx
    15 KB · Affichages: 91
  • PA0004_test.xlsx
    15.4 KB · Affichages: 109
  • MasterPA_Test.xlsx
    14.3 KB · Affichages: 93

Softmama

XLDnaute Accro
Re : VBA : Copier tableau dans un autre fichier

Re,

La partie recopie de tableau fonctionne chez moi, essaie ce code :
Code:
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.getfolder(ThisWorkbook.Path)
   
Set Files = Dossier.Files

If Files.Count <> 0 Then
    For Each File In Files
        If Left$(File.Name,6) <> "Master" And File.Name <> "~$MasterPA.xlsm" Then

Set FeuilleSource = xls.Workbooks.Open(File.Path).Worksheets("PA")
Set FeuilleCible = ActiveWorkbook.Worksheets("Actions PA")

        Lg = FeuilleCible.Cells(65536, 2).End(xlUp).Row + 1
        FeuilleSource.Range("A9").CurrentRegion.Copy
        FeuilleCible.Range("B" & Lg).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End If
...
end if
 

pierrejean

XLDnaute Barbatruc
Re : VBA : Copier tableau dans un autre fichier

Bonjour grain de sable

Salut softmama

A tester

VB:
Sub import()
Dim fso As Object, Dossier As Object, NomDossier
Dim Files As Object, File As Object, i As Integer, k As Integer
'Dim xls As New Excel.Application
Dim FeuilleSource As Excel.Worksheet, FeuilleCible As Excel.Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.getfolder(ThisWorkbook.Path)
Set Files = Dossier.Files
If Files.Count <> 0 Then
For Each File In Files
If File.Name <> "MasterPA_Test.xlsm" And File.Name <> "~$MasterPA_Test.xlsm" Then
Set FeuilleSource = Workbooks.Open(File).Worksheets("PA")
Set FeuilleCible = ThisWorkbook.Worksheets("Actions PA")
With FeuilleSource
Range("A9").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
End With
With FeuilleCible
ThisWorkbook.Activate
Lg = .Cells(65536, 2).End(xlUp).Row + 1
.Select
.Range("B" & Lg).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False ', Transpose:=False
End With
End If
Next
End If
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 165
Messages
2 085 882
Membres
103 009
dernier inscrit
dede972