Collage spécial transposé dans une macro de consolidation

[rizalo]

Bonjour à tous,

Voici une macro, récupérée sur ce site, qui permet de récupérer dans le fichier la contenant, des données de x fichiers excel présents dans le même répertoire.
Je souhaiterais la compléter pour lui dire de récupérér non seulement les données de A2 à F2 de la feuille 1, mais également les données de la feuille 6 de C5 à C15. La difficulté est que je veux que ces données (C5 à C15)présentées à l'origine verticalement, soit collées horizontalement à la suite des données copiées en A2 et F2.

Je souhaite donc que la macro fasse:
1-une copie de A2:F2 dans chacun des fichiers présents dans le répertoire
2- une copie de C5:C15 dans chacun des fichiers présents dans le répertoire
3- crée une nouvelle ligne pour chacun de ces fichiers et y colle A2:F2 puis, transposés, C5:C15

Voici en noir la macro qui fonctionne et en rouge la partie que je ne sais écrire et qui indiquerait de faire le collage transposé des données. Je l'ai indiqué ici pour expliquer mon besoin.

En vous remerciant pour vos réponses:

Sub consolide()
ChDir ActiveWorkbook.Path
Set recap = ThisWorkbook
recap.Sheets(1).Range("A2:X5000").Clear
compteur = 1

nf = Dir("*.xls")
Do While nf <> ""
If nf <> recap.Name Then
Workbooks.Open Filename:=nf
Workbooks(nf).Sheets(1).Range("A2:F2").Copy _
Destination:=recap.Sheets(1).Range("A" & recap.Sheets(1).[A1000].End(xlUp).Row + 1)
Workbooks(nf).Sheets(6).Range("C5:C15").Copy _
Transpose = True Destination:=recap.Sheets(1).Range("G" & recap.Sheets(1).[G1000].End(xlUp).Row + 1)
Workbooks(nf).Close False
End If
nf = Dir
Loop
End Sub

 

[rizalo]

Re : Collage spécial transposé dans une macro de consolidation

merci Jean Marcel,

je débute en VBA et travaille de façon empirique. Ton code fonctionne parfaitement.

Je me pemet donc de poser une autre question dans la foulée: comment faire en sorte que ma macro soit assez intelligente pour comparer les fichiers déjà importé et ne rajouter des lignes que pour les nouveaux fichiers?

 

[rizalo]

Re : Collage spécial transposé dans une macro de consolidation

voici plusieurs fichiers exemple:
1- test consolidation qui contient ma macro
2- fichier à consolider1 et ses copies: pour simuler un exemple avec plusieurs fichiers à consolider.

Au début, j'aurais le fichier de consolidation et quelques fichiers à consolider. Au fur et à mesure des mois, des nouveaux fichiers se rajouteront.

J'ai donc deux possibilités et deux questions (en bleu):

1- Je supprime du répertoire où se trouve mon fichier de consolidation tout fichier importé avec ma macro. Ensuite je crée une colonne dans mon fichier qui sera renseignée avec ma macro et qui me donnera le nom du fichier xls. Cela pemettra de vérifier ensuite si il y a des doublons dans mon fichier de consolidation.
Quelle est la commande VBA pour obtenir le nom du fichier excel utilisé?

2- Je laisse tout dans un seul répertoire et je trouve une macro qui sois assez maligne pour ne m'importer que les fichiers non traités. Là, je suis complètement à sec.

merci pour ton aide

 

[rizalo]

Re : Collage spécial transposé dans une macro de consolidation

Je suis bluffé, par la rapidité,cela marche impeccablement:

La macro importe le nom des fichiers et surtout n'importe dans le fichier que les nouveaux fichiers ajoutés.

Pour le moment je pense avoir fait le tour de la question. Un grand merci !

Peux tu, stp, m'expliquer en quelques mots la signification des lignes de code que tu as ajouté:

Sub consolide()
Dim myVar As Long
Application.ScreenUpdating = False
ChDir ActiveWorkbook.Path
Set recap = ThisWorkbook
compteur = 1

nf = Dir("*.xls")
Do While nf <> ""
If nf <> recap.Name Then
On Error GoTo GestionDesErreurs
myVar = Application.WorksheetFunction _
.Match(nf, Worksheets(1).Range("A1:A1000"), 0)
On Error GoTo 0
If IsNumeric(myVar) = False Then
Transfert: Workbooks.Open Filename:=nf
Workbooks(nf).Sheets(1).Range("A3:F3").Copy
recap.Sheets(1).Range("B" & recap.Sheets(1).[B1000].End(xlUp).Row + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Workbooks(nf).Sheets(1).Range("G6:G16").Copy
recap.Sheets(1).Range("K" & recap.Sheets(1).[K1000].End(xlUp).Row + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Workbooks(nf).Sheets(1).Range("X1:Z1").Copy
recap.Sheets(1).Range("H" & recap.Sheets(1).[H1000].End(xlUp).Row + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Workbooks(nf).Close False
recap.Sheets(1).Range("A" & recap.Sheets(1).[A1000].End(xlUp).Row + 1) = nf
End If
End If
nf = Dir
Loop
Range("F3:G3000").Select
Selection.NumberFormat = "dd/mm/yy"
Range("A1:B1").Select
GestionDesErreurs:
If Err = 1004 Then
Err = 0
Resume Transfert
End If
End Sub