Copier des colonnes positionnées différemment

Bonjour,

je connais à peine excel VBA, je m'aide des sites pour écrire mon programme, je suis complètement débutante.

Si une personne aurait la gentillesse de m'aider à finir mon programme j'en serai vraiment ravie.

Voilà, j'ai 5 feuilles dont une qui se nomme Consolidation. Je dois recopier les 4 feuilles (FACTURES SAGE - FACTURES CGA - AVOIRS CGA ET REGLT CGA dans la feuille Consolidation. Sauf que les feuilles AVOIRS CGA et REGLT CGA ne sont pas disposées de la même façon.

Je suis parvenue à copier les 2 premières feuilles (FACTURES SAGE et FACTURES CGA) mais pour les 2 autres je dois copier :

la colonne A dans la colonne A

la colonne B dans la colonne C

la colonne C dans la colonne D

la colonne D dans la colonne F de la feuille consolidation

Merci d'avance à la personne qui pourra me solutionner mon problème :

voici ce que j'ai fait :

'Procédure permettant la consolisation

'de plusieurs données

'**************************************

'Déclarations des variables

'***************************

Dim i As Integer, j As Integer

Dim DerniereLigne As Integer

Dim LastRowConsolidation As Integer

'Procédure permettant d'effacer toutes les données de la feuille de consoliation

'********************************************************************************

Sub EffaceDonnees()

Worksheets("Consolidation").Select

Rows("2:10000").Select

Selection.Clear

Range("A2").Select

End Sub

'Procédure permettant la consolidation des feuilles du classeur

'***************************************************************

Sub Consolider()

Application.ScreenUpdating = False ' Permet d'éviter le rafraîchissement

EffaceDonnees

'Boucle permettant de lire toutes les feuilles à consolider

'**********************************************************

For j = 2 To 3 'Parcours les feuilles FACTURES SAGE et FACTURES CGA

Sheets(j).Select

DerniereLigne = Range("A10000").End(xlUp).Row

For i = 2 To DerniereLigne 'Parours toutes les lignes de chaque table

Sheets(j).Select

Rows(i).Columns("A:J").Select

Selection.Copy

Sheets("Consolidation").Select

LastRowConsolidation = Range("A1000000").End(xlUp).Row + 1

Cells(LastRowConsolidation, 1).Select

ActiveSheet.Paste

Application.CutCopyMode = False

Next i

Next j

Application.CutCopyMode = True

MsgBox "La consolidation est terminée...", vbOKOnly + vbInformation, "information"

End Sub

Bonjour

Tu devrais y regarder de plus près car il semble qu''il y ait des problèmes dans les titres de colonnes ou sur les types de données qui ne correspondent pas à ces titres sur les feuilles AVOIRS CGA et REGLTS CGA

Bye !

Un essai à tester. Te convient-il ?

Bye !

Bonjour,

Oui c'est exactement ce que je souhaitais.

Merci beaucoup de ton aide je vais pouvoir maintenant faire mes TCD et revoir la présentation de mes tableaux.

Vraiment merci.

bye

Bonjour,

Je viens de m'apercevoir que pour la feuille nommée "REGLT CGA", le libellé tiers se retrouve en colonne "C" de la feuille Consolidation et je souhaiterai qu'elle aille en colonne "B". tout le reste est parfait

Peux-tu me dire stp comment puisse-je modifier le programme pour juste corriger ce detail.

Merciiiiiiiiiiiiiii

Option Explicit

Dim f As Worksheet, fc As Worksheet

Dim n&, nomf$, lgn&, derln&

Sub consolidation()

Application.ScreenUpdating = False

Call EffaceDonnees

Set fc = Sheets("Consolidation")

For n = 1 To 4

nomf = Choose(n, "FACTURES SAGE", "FACTURES CGA", "AVOIRS CGA", "REGLTS CGA")

Set f = Sheets(nomf)

derln = f.Range("A" & Rows.Count).End(xlUp).Row

lgn = Application.Max(2, fc.Range("A" & Rows.Count).End(xlUp)(2).Row)

If n = 1 Or n = 2 Then

f.Range("A2:H" & derln).Copy fc.Range("A" & lgn)

Else

f.Range("A2:A" & derln).Copy fc.Range("A" & lgn)

f.Range("B2:B" & derln).Copy fc.Range("C" & lgn)

f.Range("C2:C" & derln).Copy fc.Range("D" & lgn)

f.Range("D2:D" & derln).Copy fc.Range("F" & lgn)

End If

Next n

MsgBox "La consolidation est terminée", 16

End Sub

Bonjour

Remplace le code par celui-ci :

Bye !

Option Explicit

Dim f As Worksheet, fc As Worksheet
Dim n&, nomf$, lgn&, derln&

Sub consolidation()

    Application.ScreenUpdating = False
    Call EffaceDonnees
    Set fc = Sheets("Consolidation")
    For n = 1 To 4
        nomf = Choose(n, "FACTURES SAGE", "FACTURES CGA", "AVOIRS CGA", "REGLTS CGA")
        Set f = Sheets(nomf)
        derln = f.Range("A" & Rows.Count).End(xlUp).Row
        lgn = Application.Max(2, fc.Range("A" & Rows.Count).End(xlUp)(2).Row)
        If n = 1 Or n = 2 Then
            f.Range("A2:H" & derln).Copy fc.Range("A" & lgn)
        ElseIf n = 3 Then
            f.Range("A2:A" & derln).Copy fc.Range("A" & lgn)
            f.Range("B2:B" & derln).Copy fc.Range("C" & lgn)
            f.Range("C2:C" & derln).Copy fc.Range("D" & lgn)
            f.Range("D2:D" & derln).Copy fc.Range("F" & lgn)
        Else
            f.Range("A2:A" & derln).Copy fc.Range("A" & lgn)
            f.Range("B2:B" & derln).Copy fc.Range("B" & lgn)
            f.Range("C2:C" & derln).Copy fc.Range("D" & lgn)
            f.Range("D2:D" & derln).Copy fc.Range("F" & lgn)
        End If
    Next n
    MsgBox "La consolidation est terminée", 16
End Sub

Perfecto merci.

Merci à toi, c'est vraiment gentil ça me dépanne énormément car j'ai beaucoup de boulot derrière.

Je ne maîtrise pas du tout VBA mais je maîtrise très bien excel donc si quelqu'un à besoin d'aide je serai ravie à mon tour de dépanner une personne

Bonne journée