VBA - Fusionner données de fichier - empiler données de fichier

Bonjour à toutes et à tous, tout d'abord, bonne année à vous.

Voici, je voudrais écrire 2 codes VBA :

- L'un me permettant d'empiler les données de fichiers différents dans un même fichier ;

et un autre code

- me permettant de mettre côte à côte des données de fichiers différents dans un même fichier:
En fait, j'ai 2 fichiers de données Excel appelés fich1 et fich2 par exemple.

Dans un nouveau fichier (fich3), je voudrais mettre côte à côte les données des fichiers fich1 et fich2 sans reprendre la colonne 1 du fichier 2 (car identique à la colonne 1 du fichier 1).
Voici un code que j'ai récupéré sur ce internet (je ne m'y connais pas en VBA), il fonctionne, mais ne me permet pas de retirer la colonne 1 du fichier 2. :

Sub fusionner()
Dim classeur As Workbook
Set classeur = Workbooks.Add
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then spath = .SelectedItems(1)
End With
If Dir(spath, vbDirectory) = "" Then MsgBox "Merci de sélectionner un dossier", 16: Exit Sub
sfilename = Dir(spath & "\*.xls")
Do While sfilename <> ""
    sfullname = spath & "\" & sfilename
    With Workbooks.Open(sfullname)
        t = .Sheets(1).UsedRange.Value
        .Close True
    End With
    With classeur.Sheets(1)
        nlc = .Cells(1, .Columns.Count).End(xlToLeft).Column
        .Cells(1, nlc).Resize(UBound(t), UBound(t, 2)).Value = t
    End With
    sfilename = Dir
Loop
End Sub

Si quelqu'un peut me dépanner, j'en serais vraiment heureux.

Merci de m'avoir lu.

Bonjour

    With Workbooks.Open(sfullname)
        .Sheets(1).Columns(1).Delete ' Suppression de la première colonne
        t = .Sheets(1).UsedRange.Value
        .Close False ' Fermer sans sauvegarder
    End With

Supprimer la colonne 1 avant la copie et fermeture sans enregistrer

Bonjour,

Personnellement je te conseillerai d'utiliser power query pour compiler et modfier des bases de données plutot que le vba. Avec un exemple de tes fichiers je pourrais te montrer ce qu'il est possible de faire.

Cdt

Bonjour, merci pour votre proposition, mais il me faut forcement en VBA. merci

Bonjour yal_excel. Merci pour votre code vba ... je l'ai testé, il fonctionne mais le soucis est qu'il me supprime la colonne 1 de chacun de mes 2 fichiers... pourtant moi je ne veux que supprimer la colonne 1 du fichier 2 uniquement et conserver la totalité des colonnes du fichier 1.

Merci

Dans ce cas il suffit de déplacer l'instruction de suppression de la colonne

  With Workbooks.Open(sfullname)
' ligne à supprimer **************
      .Sheets(1).Columns(1).Delete ' Suppression de la première colonne
'********************
      t = .Sheets(1).UsedRange.Value
      .Close False ' Fermer sans sauvegarder
  End With

' et ajouter la ligne de suppression
    With classeur.Sheets(1)
        nlc = .Cells(1, .Columns.Count).End(xlToLeft).Column
        .Cells(1, nlc).Resize(UBound(t), UBound(t, 2)).Value = t
' ligne à ajouter ***************
        .Columns(1).Delete ' Suppression de la première colonne
'***************************************
    End With

Ca devrait le faire

Merci beaucoup yal_excel.

Avec un nouveau programme fonctionnant quasiment pareil que celui-ci, sauriez-vous svp, me montrer comment faire maintenant pour empiler les données des fichiers 1 et 2 dans un même fichier ... Cette fois, il n'y a aucune colonne à supprimer.. je veux juste mettre les données du fichier 2 en dessous de celles du fichier 1.

Merci d'avance.

Bonjour à tous,

Voici une adaptation du premier code pour mettre les blocs en ligne les uns à la suite des autres, sans suppression de colonne ni traitement particulier :

Sub fusionner()
Dim classeur As Workbook
Set classeur = Workbooks.Add
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then spath = .SelectedItems(1)
End With
If Dir(spath, vbDirectory) = "" Then MsgBox "Merci de sélectionner un dossier", 16: Exit Sub
sfilename = Dir(spath & "\*.xls")
Do While sfilename <> ""
    sfullname = spath & "\" & sfilename
    With Workbooks.Open(sfullname)
        t = .Sheets(1).UsedRange.Value
        .Close True
    End With
    With classeur.Sheets(1)
        nvl = .Cells(.rows.count, 1).End(xlup).row + 1
        .Cells(nvl, 1).Resize(UBound(t), UBound(t, 2)).Value = t
    End With
    sfilename = Dir
Loop
End Sub

Cdlt,