VBA copier/coller d'après les valeurs d'une liste déroulante

D'accord je vois, mais ne peut-on pas utiliser la fonction CONCATENER sur la Feuille qu'on va créer cela évite de renseigner la colonne A ?

mais ne peut-on pas utiliser la fonction CONCATENER sur la Feuille qu'on va créer cela évite de renseigner la colonne A

Non ce n'est pas évident parce que les lignes des titres peuvent varier en fonction des lignes que vous ajoutez ou retirer.
En mettant en colonne A vous êtes toujours sûr que les lignes correspondent au titre
J'ai créé une feuille Extract, qui va servir à faire ce que vous souhaitez

Faites un test sur le fichier joint
- Ouvre l'usf extract
- Choisissez dans la combobox
- Click sur le bouton.

Le code va mettre les données dans la feuille Extract puis sauvegarder un fichier TXT (nommé test.txt) dans le répertoire où se trouve votre fichier projet

J'ai nommé le fichier Test, ne sachant pas ce que vous voulez comme nom

Ok merci on avance bien, c'est pas mal du tout.

Juste une remarque les titres en bleus sont des titres majeurs et les titres verts sont des sous-titres. Ce que je veux dire par la c'est qu'il me faut toujours le titre principal avant les sous-titres dans mon fichier txt il me faut pour la ligne 24 par exemple :

GLOBAL_DIMENSIONS\DETAILED_DIMENSIONS\COTE_7 (mm) 396

Ah alors le plus simple est de faire ceci

- En A17 : mettez ceci --> =$B$12 & "\" &$B$16 puis recopiez vers le bas jusque A34
- En A36 : mettez ceci --> =$B$12 & "\" &$B$35 puis recopiez vers le base jusque A51

Faites de même pour A53 à A60

Oublier mon dernier post avec les titres principaux c'est trop complexe.

Voici ce que je propose qui est a mon avis plus simple, c'est de faire fonctionner le code comme la formule de la colonne A.

Et maintenant ce que j'aimerai c'est ajouter la valeur du projet au bout de chaque ligne de la colonne A espacé par une tabulation.

De plus j'aimerai aussi ajouter une condition au code qui est que quand la cellule "Units" est vide qu'on enlève les parenthèses.

Voici ce que je propose qui est a mon avis plus simple, c'est de faire fonctionner le code comme la formule de la colonne A.

Vous voulez avoir uniquement la valeur de la colonne A en feuille Extract ?

Et maintenant ce que j'aimerai c'est ajouter la valeur du projet au bout de chaque ligne de la colonne A espacé par une tabulation.

Pouvez-vous me donner un exemple ? (ex pour A8, A13 et A18)

De plus j'aimerai aussi ajouter une condition au code qui est que quand la cellule "Units" est vide qu'on enlève les parenthèses.

Pour cela on peut enlever la colonne D de votre formule en colonne A. On fait en sorte que ce soit le code qui va gérer

Dans l'idéal je ne voudrais rien avoir en colonne A et que mon code fasse les transformations suivantes : CONCATENER(MAJUSCULE(SUBSTITUE(B8;CAR(32);CAR(95)));" (";D8;")"). Et que le tout s'affiche dans un fichier txt avec la valeur associée au projet sélectionnée.

Voici un exemple de ce que je souhaite obtenir à la fin avec l'exemple des cellules A8, A13 et A18 :

1. Modifiez la formule en colonne A --> =CONCATENER(MAJUSCULE(SUBSTITUE(B8;CAR(32);CAR(95))))

2. Modifiez le code dans l'usf

Private Sub CommandButton1_Click()
Dim cel As Range
Dim col As Integer, lig As Integer

Sheets("Extract").Cells.ClearContents

With Sheets("Feuil1")
    col = .Rows("7:7").Find(ComboBox.Value, LookIn:=xlValues, lookat:=xlWhole).Column
    lig = 1

    For Each cel In .Range("A8:A" & .Range("B" & Rows.Count).End(xlUp).Row)

        If cel <> "" Then
            If .Range("D" & cel.Row) = "" Then
                Sheets("Extract").Range("A" & lig) = .Range("A" & cel.Row).Value & " " & .Cells(cel.Row, col).Value

            Else:
                Sheets("Extract").Range("A" & lig) = .Range("A" & cel.Row).Value & " " & "(" & .Range("D" & cel.Row).Value & ")    " & .Cells(cel.Row, col).Value
            End If

            lig = lig + 1
        End If

    Next cel
End With
Unload Me
End Sub

Le besoin de mettre en majuscule les nom avec les unités n'est plus obligatoire, désolé je me suis rendu compte de ça que tout de suite.

Du coup dans la feuille Extract il me faut en colonne A tous les noms et en colonne B leurs valeurs associées au projet sélectionné. Puis automatiser l'extraction en un fichier txt avec tabulations.

D'ailleurs est-ce possible de supprimer la feuille une fois l'extraction terminée ?

Je ne comprends plus là... et il faut recommencer

Pour les majuscules, il vous suffit de modifier votre formule en colonne A

D'ailleurs est-ce possible de supprimer la feuille une fois l'extraction terminée ?

1. Le code à changer dans votre USF EXtract data

Private Sub CommandButton1_Click()
Dim cel As Range
Dim col As Integer, lig As Integer

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Extract"

With Sheets("Feuil1")
    col = .Rows("7:7").Find(ComboBox.Value, LookIn:=xlValues, lookat:=xlWhole).Column
    lig = 1

    For Each cel In .Range("A8:A" & .Range("B" & Rows.Count).End(xlUp).Row)
        If cel <> "" Then
            Sheets("Extract").Range("A" & lig) = .Range("A" & cel.Row).Value
            Sheets("Extract").Range("B" & lig) = .Cells(cel.Row, col).Value
            lig = lig + 1
        End If
    Next cel
End With
Unload Me
End Sub

2. Le code de sauvegarde à changer dans le module

Sub Sauvegarde()
Dim chemin As String, fichier As String

chemin = ThisWorkbook.Path & "\"
fichier = "test.txt"
Sheets("Extract").Copy
ActiveWorkbook.SaveAs Filename:=chemin & fichier, FileFormat:=xlText, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = False
ThisWorkbook.Sheets("Extract").Delete
Application.DisplayAlerts = True
End Sub

Merci pour le code, cette fois-ci il fait exactement ce que je lui demande. Il reste un seul point à régler c'est dans la feuille extract je ne veux pas qu'il affiche les lignes de titres qui n'ont pas de valeurs associées

je ne vous suis pas là... C'est pas un point à régler, c'est un nouveau point

- Pourquoi supprimez vous la colonne A ?

- Aussi pourquoi vous encombrer avec une macro supplémentaire pour supprimer la feuille. Le code que je vous ai proposé la supprime en deux lignes lors de la sauvegarde du fichier text.

- Dans votre fichier vous n'avez besoin que d'un module qui reprend tous les codes

Edit : Pour l'affichage des lignes de titres, vous pouvez toujours tester en remplaçant

If cel <> "" then

par

If cel.Offset(, 4) <> "" Then

ou mieux comme ceci

If cel.Offset(, 4) <> vbNullString Then

Bonjour,

j'aimerai ajouter la colonne D celle des unités de ma feuille 1 dans la feuille "Extract" en colonne B, à la suite des valeurs du projet ?

Merci d'avance

Bonjour

Dans le code Private Sub CommandButton1_Click(), ajoutez cette ligne juste en dessous de Sheets("Extract").Range("A" & lig)=

Sheets("Extract").Range("B" & lig) = .Range("D" & cel.Row).Value

Crdlt

Bonjour,

j'ai essayé votre méthode mais ça n'a pas fonctionné, j'ai donc procédé de la manière suivante ça fonctionne :

Sheets("Extract").Range("A" & lig) = .Range("B" & cel.Row).Value
Sheets("Extract").Range("B" & lig) = .Cells(cel.Row, col).Value & Space(1) & .Range("D" & cel.Row).Value

Par contre, quand j'extrait les données d'un projet contenant des valeurs décimales, celles-ci sont accompagnées de guillemets dans le fichier texte, que faire pour les retirer ?

j'ai essayé votre méthode mais ça n'a pas fonctionné, j'ai donc procédé de la manière suivante ça fonctionne :

J'ai été un peu vite pour vous répondre.

Les unités ^placées en colonne C. Ce serait bon cela ?

Pas de problème, non je souhaite les unités à la suite des valeurs dans la colonne B.

Pour ce qui est du problème des guillemets j'ai trouvé ce code sur internet mais j'ai dû mal à l'intégrer dans mon fichier

Sub rangeToTXT()
    Dim Fichier As String, f As Integer, Path As String
    Selection.Copy
    Path = Environ("userprofile") & "\chemin\"     ' Mettre chemin
    NomduFichier = InputBox("Please enter the name of the txt file", "Name of the file", "File")
    If NomduFichier <> "" Then
        Fichier = Path & NomduFichier & ".txt"
        f = FreeFile
        Open Fichier For Output As #f
        Print #f, CreateObject("htmlfile").parentwindow.clipboardData.GetData("TEXT")   'Ecrit chaine dans fichier
        Close #f
    End If
End Sub

Pas besoin de ce code c'est l'instruction Space qui vous provoque cela. Juste pour vous sachiez, votre ligne peut être modifiée comme ceci.

Sheets("Extract").Range("B" & lig) = .Cells(cel.Row, col).Value & " " & .Range("D" & cel.Row).Value

Mais essayez plutôt comme ceci. On place les unités en colonne C:

Private Sub CommandButton1_Click()
Dim cel As Range
Dim col As Integer, lig As Integer

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Extract"

With Sheets("Feuil1")
    col = .Rows("7:7").Find(ComboBox.Value, LookIn:=xlValues, lookat:=xlWhole).Column
    lig = 1

    For Each cel In .Range("B8:B" & .Range("B" & Rows.Count).End(xlUp).Row)
        If cel.Offset(, 4) <> "" Then
            Sheets("Extract").Range("A" & lig) = .Range("B" & cel.Row).Value
            Sheets("Extract").Range("B" & lig) = .Cells(cel.Row, col).Value
            Sheets("Extract").Range("C" & lig) = .Range("D" & cel.Row).Value
            lig = lig + 1
        End If
    Next cel
End With
Call Sauvegarde
Unload Me
Call Supprimer
End Sub

J'ai remplacé l'instruction Space par " " mais j'ai toujours les guillemets qui apparaissent dans mon fichier texte. Mes données sont ensuite traitées par un autre logiciel et j'ai absolument besoin que les unités soient dans la même cellule que la valeur espacé par un espace.

De plus, dans le programme que j'ai envoyé j'aime le fait de pouvoir choisir le nom du fichier que l'on va créer.

J'ai remplacé l'instruction Space par " " mais j'ai toujours les guillemets qui apparaissent dans mon fichier texte.

Voilà le fichier texte que j'ai généré en utilisant l'instruction " "

Ce n'est pas ce que vous voulez ?

De plus, dans le programme que j'ai envoyé j'aime le fait de pouvoir choisir le nom du fichier que l'on va créer.

Vous n'aviez demandé mais cela peut se faire bien entendu

Edit : pour le choix du nom de ficher, remplacez le code par celui ci-dessous

Sub Sauvegarde()
Dim chemin As String, fichier As String

chemin = ThisWorkbook.Path & "\"
fichier = InputBox("Veuillez choisir un nom de fichier", "Choix Nom Fichier")

If fichier <> "" Then
    Sheets("Extract").Copy
    ActiveWorkbook.SaveAs Filename:=chemin & fichier, FileFormat:=xlText, CreateBackup:=False
    ActiveWorkbook.Close
End If
End Sub