vba macro extraction

[marouan]

bonjour,

je vous explique malheureusement n'ayant plus de temps pour rendre un fichier excel de référence des sociétés qualibat en idf je fais appel a vous pour m aider je ne suis pas très caler en vba j ai essayer de faire un code qui fonctionne j ai pris des info ici et la pour le faire. vous le trouverez dans l encadrer en dessous de la piece jointe.

ce que je dois réaliser c'est dans un premier temps faire une macro dans la feuille "lancement" pour faire des recherche via ma liste deroulante "département" afin de pouvoir selectionner les informations souhaitées via mon fichier source par département après pouvoir finaliser ma recherche avec les autres cellules apres si possible ecrire dans la case "raison social" le nom de la raison sociale pour aller chercher la ligne complete correspondant.

ensuite sur la feuille "fichier source" c'est un exemple tres réduit de mon tableau de référence avec les colonnes en rouge que je souhaite remplir via la macro par rapport au fichier excel avec cellues colories en jaune et rouge

je sais pas si je suis claire

merci pour votre coup de main et votre aide j en aurai besoin

 

[marouan]

Re : vba macro help me

voici le debut de ma macro pour l'extraction des informations du fichier excel à mon tableau fichier source.


Sub essai()

Dim Fiche_Recap As Worksheet
Dim Fiche_Source As Worksheet
Dim Deb_Lste As Range
Dim Fin_Lste As Range
Dim Liste_Frs As Range
Dim Frs As String
Dim MaCell


Set Fiche_Recap = ThisWorkbook.Worksheets("Fiche1")
Set Deb_Lste = Fiche_Recap.Range("B23")
Set Fin_Lste = Fiche_Recap.Range("B2990")
Set Liste_Frs = Range(Deb_Lste, Fin_Lste)



Set Fiche_Source = Workbooks("D75-Srce.xls").Worksheets("Page 1")



Fiche_Source.Activate
Range("A2").Select
suite:
If ActiveCell.Value = "Effectif moyen :" Then
ActiveCell.Offset(0, 2).Copy
Else
ActiveCell.Offset(1, 0).Select
GoTo suite
End If
Fiche_Recap.Activate
Fiche_Source.Activate
Range("J1").Select '

Faire:
If ActiveCell.Value <> "" Then
GoTo Ecrire
Else
ActiveCell.Offset(1, 0).Activate
GoTo Faire
End If

Ecrire:
ActiveCell.Offset(0, 1).Activate
ActiveCell.FormulaR1C1 = "=REPLACE(RC[-1],1,18,"""")"
Frs = ActiveCell.Value

Fiche_Recap.Activate
'MaCell = Frs

Set MaCell = Liste_Frs.Find(What:=Frs, LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)

If Not MaCell Is Nothing Then
MaCell.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

End Sub

 

[laetitia90]

Re : vba macro help me

bonjour je t'invite a lire la chartre du forum

 

[laetitia90]

Re : vba macro help me

re ,vu que tu reponds par message privé
je vais te commenter les grandes lignes du forum
on commence par un tout petit bonjour
on fini par un petit merci
le titre jamais de texte "accrocheur" donc help me... au secours ect...
avec le titre on peut facilement une recherche dans le forum
exemple titre " probleme module de classe" ect..
mettre un fichier exemple c'est pas de trop
c'est tout bonne soirée