[Résolu]Importer 1 colonne d'un classeur à un autre, à partir de la 1ère cellule vide

[SneakyZEKE]

Bonjour,

J'ai conscience que ce cas à été traité moult fois mais comme je ne suis pas très doué, je n'arrive pas à appliquer les solutions que je trouve à mon problème...

Jusqu'ici j'ai récupéré ce bout de code sur le forum qui m'ouvre bien une fenêtre d'import de fichier :

Option Explicit

    Sub importer()
        Dim fin&, début&, wbksource As Workbook, wbkcible As Workbook, Fichier$, fd As Object, Nom$
        Set wbkcible = ThisWorkbook
        Fichier = ThisWorkbook.Path
        Set fd = Application.FileDialog(msoFileDialogOpen)
        With fd
            .Title = "Choisissez le Fichier pour Importer les Données"
            .InitialFileName = Fichier & "\1_Donnees_brutes\"
            .Filters.Clear
            .Filters.Add "Fichier Excel", "*.xls*"
            .AllowMultiSelect = True
            If .Show <> 0 Then
                Nom = .SelectedItems(1)
            Else
                MsgBox "Vous n'avez aucun fichier" & vbCrLf & _
                "ou Vous n'avez choisi aucun Fichier ", , "Manque de Fichier": GoTo 1
            End If
        End With
        Set wbksource = Workbooks.Open(Nom)
        'If ActiveSheet.Range("E1") = "Transféré" Then MsgBox "Ce fichier a déjà été Transféré", , "Fichier déjà transféré": GoTo 2
       ActiveSheet.Range("A3:B100" & ActiveSheet.Range("B100").End(xlUp).Row).Copy wbkcible.Sheets("Base globale").Range("B100").End(xlUp).Offset(1, 0)
       
        wbksource.ActiveSheet.Range("E1") = "Transféré"
        wbksource.Close savechanges:=True
1
    début = ActiveSheet.Range("A65536").End(xlUp).Row
    fin = ActiveSheet.Range("A65536").End(xlUp).Row

    GoTo 3
2     wbksource.Close savechanges:=False
3
    End Sub

Problème, je désirs récupérer le contenu des cellules non vides entre A3:A100 et B3:B100 d'une feuille "SupClefs" et d'un classeur nommé "Clefs Supplément", les concaténer (sous la forme "A3 - B3", "A4 - B4", "A5 - B5"...) et renvoyer le résultat en colonne G de ma feuille "BASE" (classeur "Projet") à la suite des données déjà présentes entre G3 et G1000.

Je ne sais pas si je suis très clair, l'idée c'est que j'ai une colonne G3:G1000 dans laquelle se trouve des chaines de caractères sous la forme ***** - ***. Théoriquement il n'y a pas de cellules vides entre deux cellules pleines dans cette colonne, et je souhaiterai pouvoir importer 2 colonnes d'un autre fichier xls, les concaténer, et les mettre dans la première cellule vide de ma colonne G3:G1000.

Si c'est toujours pas clair je veux bien ré-expliquer ou répondre aux questions si besoin est ?

 

[Papou-net]

Re : Import de 2 colonnes d'un fichier xls dans un autre classeur.

Bonjour SneakyZEKE,

Si j'ai bien compris ta demande, voici ton code modifié :

Option Explicit

Sub importer()
Dim fin&, début&, wbksource As Workbook, wbkcible As Workbook, Fichier$, fd As Object, Nom$
Dim Lg As Long, Ch As String
Set wbkcible = ThisWorkbook
Fichier = ThisWorkbook.Path
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
  .Title = "Choisissez le Fichier pour Importer les Données"
  .InitialFileName = Fichier & "\1_Donnees_brutes\"
  .Filters.Clear
  .Filters.Add "Fichier Excel", "*.xls*"
  .AllowMultiSelect = True
  If .Show <> 0 Then
    Nom = .SelectedItems(1)
    Else
    MsgBox "Vous n'avez aucun fichier" & vbCrLf & _
      "ou Vous n'avez choisi aucun Fichier ", , "Manque de Fichier": GoTo 1
  End If
End With
Set wbksource = Workbooks.Open(Nom)
wbksource.Sheets("SupClefs").Activate
If ActiveSheet.Range("E1") = "Transféré" Then MsgBox "Ce fichier a déjà été Transféré", , "Fichier déjà transféré": GoTo 2
Lg = wbkcible.Sheets(1).Range("G65536").End(xlUp).Row + 1
With ActiveSheet.Range("A3:B100").SpecialCells(xlCellTypeConstants)
  For Each cel In ActiveSheet.Range("A3:B100").SpecialCells(xlCellTypeConstants)
    Select Case cel.Column
      Case 1
        Ch = cel.Value
      Case 2
        Ch = Ch & " - "
        wbkcible.Sheets("BASE").Range("G" & Lg).Value = Ch
        Lg = Lg + 1
    End Select
  Next
End With
wbksource.ActiveSheet.Range("E1") = "Transféré"
wbksource.Close savechanges:=True
1:
début = ActiveSheet.Range("A65536").End(xlUp).Row
fin = ActiveSheet.Range("A65536").End(xlUp).Row
GoTo 3
2:
wbksource.Close savechanges:=False
3:
End Sub

Espérant avoir répondu.

Cordialement.

 

[SneakyZEKE]

Re : Import de 2 colonnes d'un fichier xls dans un autre classeur.

Merci Papou-net, j'ai pas trop le temps de regarder pourquoi là tout de suite, mais apriori ça coince sur le "cel"...

J'essaye d'éclaircir ma demande ce soir ou demain matin, car je me rend compte que mon bout de code récupéré sur le net doit prêter à confusion...je ne comprends pas :

wbksource.ActiveSheet.Range("E1") = "Transféré"

et :

 début = ActiveSheet.Range("A65536").End(xlUp).Row
fin = ActiveSheet.Range("A65536").End(xlUp).Row

car je ne souhaite pas modifier la case E1 et que mon tableau de ma feuille "BASE" n'a que 1000 lignes.

Je tâche d'éditer une meilleure demande au plus vite...

 

[SneakyZEKE]

Re : Import de 2 colonnes d'un fichier xls dans un autre classeur.

Je pense que cette approche sera beaucoup plus parlante...je joints une partie de mon projet avec une ébauche pas au point de ma requête qui devrait être relativement parlante en regardant l'image qui l'accompagne.

J'ai aussi laisser la fonction Enregistrer en tant que page web qui fonctionne théoriquement sur PC 32 bits mais pas sur 64 bits faute à l'utilisation d'une dll 32 bits. Tout ça pour dire que je l'ai laissé car je voudrais le même type de boite de dialogue, avec le chemin qui s'affiche comme pour l'export du Ficher Cesi mais là pour l'import de deux colonnes d'un fichier xls à concaténer et introduire à la suite de la colonne G de la feuille BASE de mon fichier xls primaire. Le pompon serai qu'à chaque ajout d'une clef en colonne G, la cellule en colonne H de la même ligne prenne la valeur "S"...

Je pense que pour celui qui programme un peu c'est pas spécialement difficile au point de vu code, c'est juste que j'ai du mal à exprimer ma demande...et comme moi je programme pas vraiment, je me contente de récupérer des bouts de code et de les adapter à mes problèmes, sur un cas comme celui là ça me dépasse un peu.

 

[Papou-net]

Re : Import de 2 colonnes d'un fichier xls dans un autre classeur.

Bonjour SneakyZEKE,

Bien reçu tes fichiers, mais il m'est impossible d'ouvrir le fichier zip : J'obtiens le message d'erreur "Format de fichier non valide".

Mais d'après ce que je pense avoir compris, le fichier que je t'ai adressé répond à ta demande. Le seul problème vient de ce que j'ai omis de déclarer la variable Cel, d'où la raison du dysfonctionnement. C'est réparé sur la copie ci-jointe, que j'ai d'ailleurs revue à la simplification. J'ai mis les lignes concernant la cellule E1 en commentaires, tu peux donc les supprimer si tu le juges nécessaire. Puisque ton fichier n'a que 1000 lignes, j'ai aussi remplacé "G65536" par "G1OOO".

Pour le reste de tes questions, n'ayant pu ouvrir Projet.zip et ton image étant peu lisible, je ne peux te répondre, pour le moment du moins. Tu peux joindre une version allégée de tes fichiers, en passant par Cijoint.fr - Service gratuit de dépôt de fichiers si nécessaire.

A te lire.

Cordialement.

 

[SneakyZEKE]

Re : Import de 2 colonnes d'un fichier xls dans un autre classeur.

Oui, c'est un fichier 7zip car le format zip classique ne compressait pas suffisamment pour atteindre les 48Ko acceptés par le site. Et comme le site n'accepte ni 7z, ni rar, j'ai juste changer l'extension de mon fichier 7z...avec les archiveurs 7zip et WinRAR il l'ouvre quand même mais avec les autres archiveurs je ne sais pas :/

Bref, il y a du mieux sur le code mais la concaténation ne se fait pas et et la boite de dialogue avec dialogue et chemin affiché qui va bien est un peu court-court-court-circuitée, même si c'est pas le plus important. En l'état, dès que le fichier est sélectionné, la colonne A3:A100 de ma feuille SupClef, est copiée telle qu'elle en suite de ma colonne G:G. J'ai essayé d'utiliser l’enregistreur de macro et une formule de concaténation dans une feuille invisible dans mon classeur "Clefs Supplément" mais je vais plutôt chercher une vraie concaténation VBA car là le résultat n'est pas probant...le classeur à atteint les 2 Mo !

D'ailleurs à ce sujet je me rend compte qu'entre mon école (XP + Excel 2003) et mon domicile (Seven 64 bits +Excel 2010)...bah il n'y a plus grand chose qui fonctionne :/ Je trouve ça un peut dommage ce manque de rétrocompatibilité dans ce sens. De 64 bits à 32 ou de Excel 2010 à 2003 j'aurai compris mais là bof bof ! J'ai cette fonction qui ne passe plus :

Private Declare Function ShellExecuteEX Lib "shell32.dll" _
   Alias "ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" _
   Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

PS : J'ai tenté d'uploader mon xls ou en sous forme d'archive sur Cijoint mais le lien qui m'est donné renvoi vers un fichier de 8,2Ko contenant de la pub pour Cijoint pour le premier et corrompu pour le second :/ Je sais pas ce que j'ai fait de travers....

 

[SneakyZEKE]

Re : Import de 2 colonnes d'un fichier xls dans un autre classeur.

Celle-ci j'espère que tout le monde pourra l'ouvrir, c'est une vraie archive ZIP de type LZMA et en compression Ultra...

Sinon pour ce qui de mon souci...j'ai essayé de simplement créer une feuille "concatenation" dans mon classeur "Supplément Clefs" à base de formules du type :

=SI(SupClefs!A3<>"";CONCATENER(SupClefs!A3;" - ";SupClefs!B3);"")

...étendues sur une colonne "A1:A98", puis copié cette colonne à la suite de ma colonne "G" de mon classeur "projet" en feuille "BASE"...

Problèmes...mon classeur "Supplément Clefs" atteint cette fois-ci les 5,21 Mo et même copier une colonne dans la première cellule vide de ma colonne G, feuille "BASE", classeur Projet...et bah même ça j'y arrive pas :/

 

[SneakyZEKE]

Re : Import de 2 colonnes d'un fichier xls dans un autre classeur.

Personne ne peut m'aider ?

J'ai refais mon fichier "Clefs Supplément" et il atteint désormais une taille descente...je remets mes fichier groupires de façons à facilité la lisibilité de mon post et je précise que dorénavant, sauf indications contraires, j'ai oublié la concaténation incluse dans la macro pour simplifier les choses (je procède dorénavent par formule...) et qu'il s'agit en fait d'importer mon classeur "Clefs Supplément" via mon formulaire Import XLS pour en copier toutes les cellules non vides de ma feuille "concatenation" et les coller à la suite (à partir de la première cellule vide) de la colonne G:G de la feuille BASE du classeur projet...

La fonction Partage est là pour montrer le type de boite que j'aimerai sauf que l'une sert pour un enregistrement en tant que page web et que l'autre servira d'import de données...mais je souhaiterai garder la même forme de boite...

Vraiment personne ? :/

 

[SneakyZEKE]

Importer 1 colonne d'un fichier xls à un autre, à partir de la première cellule vide.

Changement de stratégie...ayant choisi de concaténer directement les n° de clef et de puce, dans une seconde feuille du classeur Clefs supplément, nommée "concatenation" et à l'aide de formules...il faudrait que j'importe la colonne "A1:A98" de la feuille "concatenation", vers la colonne "G3:G1000" de ma feuille "BASE" du classeur "Projet", et ce à partir de la première cellule vide de cette colonne "G".

Il s'agit d'une copie de colonne d'un classeur à un autre, la subtilité se situant dans le fait que cette colonne doit-être copié à partir de la première cellule vide de la colonne "G". Mon ébauche est un mélange de ce qui m'a été proposé plus haut et de ce que j'ai observé avec l'enregistreur de macro mais je n'arrive pas à retrouver la première cellule vide pour déterminer où la copie doit se faire :

Option Explicit

Sub importer()
Dim Fin&, début&, wbksource As Workbook, wbkcible As Workbook, Fichier$, fd As Object, Nom$
Dim Lg As Long, Ch As String, Cel As Range
Set wbkcible = ThisWorkbook
Fichier = ThisWorkbook.Path
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
  .Title = "Choisissez le Fichier contenant les clefs supplément"
  .InitialFileName = Fichier & "\1_Donnees_brutes\"
  .Filters.Clear
  .Filters.Add "Fichier Excel", "*.xls*"
  .AllowMultiSelect = True
  If .Show <> 0 Then
    Nom = .SelectedItems(1)
    Else
    MsgBox "Vous n'avez aucun fichier" & vbCrLf & _
      "ou Vous n'avez choisi aucun Fichier ", , "Manque de Fichier": Exit Sub
  End If
End With
Set wbksource = Workbooks.Open(Nom)
wbksource.Sheets("Concatenation").Activate
Range("A1:A98").Select
Selection.Copy
wbkcible.Sheets("BASE").Activate
Range("G863:G960").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

 

[SneakyZEKE]

Re : Importer 1 colonne d'un fichier xls à un autre, à partir de la première cellule

J'avais un peu oublié de mettre à jour le forum à travailler sur plusieurs fronts à la fois mais c'est résolu pour ça ! Voici mon code si ça peut aider quelqu'un, bien que tout ça est utiliser dans un environnement bien particulier qui ne se prête pas spécialement à une réutilisation...mais sait-on jamais :

Option Explicit

Sub importer()
Dim vrtSelectedItem As Variant, wbksource As Workbook, wbkcible As Workbook, fd As Object, Nom$
Dim NbClés As Integer, Ligne As Integer

Set wbkcible = ThisWorkbook
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
  .Title = "Choisissez le Fichier contenant les clés supplément"
  .InitialFileName = "R:\Infrastructures (IFT)\SERDIS\application serdis\Clés supplément.xls"
  .Filters.Clear
  .Filters.Add "Fichier Excel", "*.xls*"
  .AllowMultiSelect = False
  If .Show <> 0 Then
    Nom = .SelectedItems(1)
    Else
    MsgBox "Aucun fichier n'a été sélectionné", , "Erreur": Exit Sub
  End If
End With
Application.ScreenUpdating = False
Set wbksource = Workbooks.Open(Nom)
wbksource.Sheets("SupClés").Activate
If Range("A3") = "" Then
    ActiveWindow.Close SaveChanges:=False
    wbkcible.Sheets("BASE").Activate
    Application.ScreenUpdating = True
    MsgBox "Le fichier 'Clés supplément.xls' est vide !"
    Exit Sub
Else
    wbksource.Sheets("Concatenation").Visible = xlSheetVisible
    wbksource.Sheets("Concatenation").Activate
    NbClés = Sheets("SupClés").Range("A1").End(xlDown).Row - 2 'compte le nombre de clés à copier
    Range("A1:A" & NbClés).Select
    Selection.Copy
    wbkcible.Sheets("BASE").Activate
    Ligne = Sheets("BASE").Range("G2").End(xlDown).Row + 1
    If NbClés = 1 Then
            Range("G" & Ligne).Select
        Else
            Range("G" & Ligne, "G" & Ligne + NbClés).Select
    End If
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("H" & Ligne, "H" & Ligne + NbClés - 1) = "S"
    wbksource.Sheets("Concatenation").Visible = xlSheetVeryHidden
    wbksource.Sheets("SupClés").Activate
    wbksource.Sheets("SupClés").Range("A3:A100").ClearContents
    wbksource.Sheets("SupClés").Range("B3:B100").ClearContents
    Confirmation.Show
    Windows("Clés supplément.xls").Activate
    ActiveWorkbook.Save
    ActiveWindow.Close
    wbkcible.Sheets("BASE").Activate
    Call Module3.Afficher
    Application.ScreenUpdating = True
    ActiveWorkbook.Save
End If
End Sub