Programme VBA copier/coller
Résolu
mike7182
Messages postés
3
Date d'inscription
jeudi 7 décembre 2023
Statut
Membre
Dernière intervention
8 décembre 2023
-
7 déc. 2023 à 09:52
mike7182 Messages postés 3 Date d'inscription jeudi 7 décembre 2023 Statut Membre Dernière intervention 8 décembre 2023 - 8 déc. 2023 à 09:46
mike7182 Messages postés 3 Date d'inscription jeudi 7 décembre 2023 Statut Membre Dernière intervention 8 décembre 2023 - 8 déc. 2023 à 09:46
A voir également:
- Vba copier coller
- Copier coller pdf - Guide
- Copier une vidéo youtube - Guide
- Super copier - Télécharger - Gestion de fichiers
- Copier coller formule excel sans décalage ✓ - Forum Bureautique
- Copier coller multiple - Guide
2 réponses
NonoM45
Messages postés
268
Date d'inscription
dimanche 14 juin 2009
Statut
Membre
Dernière intervention
21 mars 2024
7 déc. 2023 à 19:08
7 déc. 2023 à 19:08
Bonsoir mike7182
Voici une possibilité
Sub Copier_Coller() ' Variables Dim Sht1 As Worksheet, Sht2 As Worksheet Dim dLig1 As Long, Lig1 As Long, nLig2 As Long ' Procédure Set Sht1 = ThisWorkbook.Sheets("Feuil1") Set Sht2 = ThisWorkbook.Sheets("Feuil2") dLig1 = Sht1.Range("A" & Rows.Count).End(xlUp).Row For Lig1 = 1 To dLig1 If InStr(1, Sht1.Range("A" & Lig1), "texte à copier", vbTextCompare) > 0 Then nLig2 = Sht2.Range("A" & Rows.Count).End(xlUp).Row + 1 Sht1.Range("A" & Lig1).Copy Destination:=Sht2.Range("A" & nLig2) End If Next Lig1 End Sub
A+
thev
Messages postés
1853
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
27 avril 2024
681
Modifié le 7 déc. 2023 à 19:30
Modifié le 7 déc. 2023 à 19:30
Bonsoir,
Une autre proposition :
Sub copie_texte() Dim texte_à_chercher As String Dim cell As Range, cell1 As Range texte_à_chercher = "XXX" Set cell = Feuil1.Cells.Find(texte_à_chercher, LookAt:=xlWhole) If Not cell Is Nothing Then Set cell1 = cell Do Set cell_copiée = Feuil2.Columns(1).Find(""): If cell_copiée Is Nothing Then Set cell_copiée = Feuil2.Range("A1") cell_copiée.Value = cell.Offset(1).Value Set cell = Feuil1.Cells.Find(texte_à_chercher, After:=cell) Loop Until cell.Address = cell1.Address End If End Sub
mike7182
Messages postés
3
Date d'inscription
jeudi 7 décembre 2023
Statut
Membre
Dernière intervention
8 décembre 2023
1
8 déc. 2023 à 09:46
8 déc. 2023 à 09:46
merci
thev pour cette réponse ça m'a aidé avec le programme de NonoM45 et en compilant un peu les deux j'ai obtenu le résultat que je voulais
8 déc. 2023 à 09:38
merci
ce petit programme m'a bien aidé avec quelques modifications pour ce que je voulais exactement j'ai réussi à obtenir le résultat que je voulais
encore merci NonoM45