[VB.Excel] incrémenter, copier et coller le résulta
Résolu/Fermé
ProMed1
Messages postés
30
Date d'inscription
dimanche 27 mai 2018
Statut
Membre
Dernière intervention
13 avril 2021
-
Modifié le 18 mars 2019 à 23:44
ProMed1 Messages postés 30 Date d'inscription dimanche 27 mai 2018 Statut Membre Dernière intervention 13 avril 2021 - 22 mars 2019 à 21:24
ProMed1 Messages postés 30 Date d'inscription dimanche 27 mai 2018 Statut Membre Dernière intervention 13 avril 2021 - 22 mars 2019 à 21:24
A voir également:
- [VB.Excel] incrémenter, copier et coller le résulta
- Copier coller pdf - Guide
- Copier une vidéo youtube - Guide
- Symbole coeur copier-coller ✓ - Forum Réseaux sociaux
- Super copier - Télécharger - Gestion de fichiers
- Dessin sms copier coller - Forum Jeux vidéo
3 réponses
ProMed1
Messages postés
30
Date d'inscription
dimanche 27 mai 2018
Statut
Membre
Dernière intervention
13 avril 2021
18 mars 2019 à 23:27
18 mars 2019 à 23:27
Option Explicit Dim NomClasseur As String Dim MonChemin As String Dim WB As Workbook Dim x As Long Dim y As Long Dim lig1 As Long, lig2 As Long Dim Val1 As String Dim Val2 As String Dim DernierLigne As Integer Sub Consolider() MonChemin = InputBox("Merci de coller le chemin de vos fichiers sur la zone de texte: ") & "\" NomClasseur = Dir(MonChemin & "\*.xlsx*") Do While NomClasseur <> "" Application.DisplayAlerts = False Set WB = Workbooks.Open(MonChemin & NomClasseur) WB.Activate For lig1 = 10 To 15 'boucle sur la plage "B10:B15" x = 0 If InStr(1, Cells(lig1, 2), "M") = 1 Or InStr(1, Cells(lig1, 2), "T") = 1 Then 'si la chaine de texte commence par M ou T Range("F1").Value = "OK" 'F1= OK, F2 = OK, F3 = OK ... tant que Cells(lig1, 2)= M ou T Range("G1").Value = Range("A10").Value 'G1= OK, G2 = OK, G3 = OK ... tant que Cells(lig1, 2)= M ou T Val1 = Cells(lig1, 4).Value If IsNumeric(Val1) Then 'verifier si la Cells(lig1, 4) est numerique Range("H1").Value = "OK" 'si oui H1= OK, H2 = OK, H3 = OK ... tant que Cells(lig1, 2)= M ou T + Cells(lig1, 4) est numerique Else Range("H1").Value = "NOK" 'si non H1= NOK, H2 = NOK, H3 = NOK ... tant que Cells(lig1, 2)= M ou T + Cells(lig1, 4) est non numerique End If Range("I1").Value = Cells(lig1, 4).Value 'I1, I2, I3... = Cells(lig1, 4).Value tant que Cells(lig1, 2)= M ou T Range("J1").Value = Cells(lig1, 3) 'J1, J2, J3... = Cells(lig1, 3).Value tant que Cells(lig1, 2)= M ou T Val2 = Cells(lig1, 2).Value For lig2 = 2 To 5 'boucle sur la plage "A2:A5" y = 0 If Cells(lig2, 1).Value = Val2 Then 'verifier si la Cells(lig2, 1)= à Val2 Range("K1").Value = Cells(lig2, 5).Value 'si oui K1, K2, K3... =Cells(lig2, 5) tant que Cells(lig1, 2)= Val2 Else Range("K1").Value = "NOK" 'si non J1, J2, J3... =Cells(lig2, 5) tant que Cells(lig1, 2)= NOK End If Next lig2 Else Range("F1").Value = "OK" 'F1= OK, si la chaine de texte ne commence pas par M ou T Range("G1").Value = Range("A10").Value 'G1= A10, si la chaine de texte ne commence pas par M ou T Range("L1").Value = "NOK" 'L1= NOK, si la chaine de texte ne commence pas par M ou T x = x + 1 End If Next lig1 Range("F1:L1").Copy Workbooks("Classeur1.xlsm").Activate DernierLigne = ActiveSheet.UsedRange.Rows.Count + 1 Range("A" & DernierLigne).Select ActiveSheet.Paste Workbooks(NomClasseur).Close Application.DisplayAlerts = True NomClasseur = Dir Loop MsgBox "Le traitement est terminer." End Sub
ProMed1
Messages postés
30
Date d'inscription
dimanche 27 mai 2018
Statut
Membre
Dernière intervention
13 avril 2021
18 mars 2019 à 23:33
18 mars 2019 à 23:33
merci beaucoup :)
ProMed1
Messages postés
30
Date d'inscription
dimanche 27 mai 2018
Statut
Membre
Dernière intervention
13 avril 2021
22 mars 2019 à 21:24
22 mars 2019 à 21:24
Problème résolu, je tiens à remercier "f894009" trait fort.
18 mars 2019 à 23:30
18 mars 2019 à 23:31