Code VBA recopier selon condition

dgeo27

XLDnaute Junior
Bonjour, mon petit programme touche à sa fin
icon_smile.gif

Mais me manque un code que j'ai commencer mais qui forcément ne fonctionne pas je suis nul
icon_lol.gif


Feuille : Facture
Feuille : Devis_2018
Feuille : Facture_2018

Sur la feuille Facture en cellule B24 il y à un numéro qui commence soit par F (facture) ou par D (devis) par exemple F201800001

Mon but ; recopier plusieurs cellules en recherchant le même numéro en colonne "A" (que sa soit dans facture_2018 ou devis_2018) et copier les cellule de la ligne en question. Avec comme condition : SI le numéro en B24 commence par F alors il va copier les cellules qui sont dans la feuille Facture_2018 et SI sa commence par D dans Devis_2018 ...


Données à copier : Colonne par exemple : K - L - M - N (facture_2018 ou devis_2018 ils ont la même structure)
A coller : dans B13 - C13 - G13 - H13

voila un début de code enfin je pense


Sub Recopie_infos()


Dim FeFacture As Worksheet
Dim FeFacturier As Worksheet
Dim FeDevis As Worksheet
Dim Tbl
Dim Lig As Long
Dim I As Integer

Set FeFacture = Worksheets("Facture")
Set FeFacturier = Worksheets("Facturier_2018")
Set FeDevis = Worksheets("Devis_2018")

If MsgBox("Continuer ?", 36, "Confirmation") = vbYes Then
'Code à exécuter si OUI

'condition pour qu'il recherche si sa commence par F ou par D ...'
If UCase



Merci à vous
 

youky(BJ)

XLDnaute Barbatruc
Bonjour j'avais commencé sans fichier alors j'ai amélioré.
Avec les fusions de cellules c'est moins rapide
Voici la macro
Bruno
VB:
Sub mycopie()
If MsgBox("Continuer ?", 36, "Confirmation") = vbNo Then Exit Sub
devfac = IIf(Left(Sheets("Facture").[B24], 1) = "F", "Facturier_", "Devis_")
devfac = devfac & "2018"
Lig = Application.Match(Sheets("Facture").[B24], Sheets(devfac).[A1:A65000], 0)
If Not IsNumeric(Lig) Then MsgBox "Non trouvé N°": Exit Sub
'copie Nom prénom
With Sheets("Facture")
.Range("B9").Value = Sheets(devfac).Range("B3").Value
.Range("D9").Value = Sheets(devfac).Range("C3").Value
'ajout de lignes pour les autres

'copie Taux et le reste
Ligtaux = 13: col = 11
For k = 1 To 10
.Range("B" & Ligtaux).Value = Sheets(devfac).Cells(Lig, col).Value
.Range("C" & Ligtaux).Value = Sheets(devfac).Cells(Lig, col + 1).Value
.Range("G" & Ligtaux).Value = Sheets(devfac).Cells(Lig, col + 2).Value
.Range("H" & Ligtaux).Value = Sheets(devfac).Cells(Lig, col + 3).Value
Ligtaux = Ligtaux + 1
col = col + 6
Next
End With
End Sub

PS: en B24 il manque un zéro dans le N°facture
 

Discussions similaires

Réponses
9
Affichages
1 K

Membres actuellement en ligne

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 846
dernier inscrit
Silhabib