Recherche de valeurs entre deux bornes et faire copie/colle
Bonjour à tous,
je suis en difficulté sur une macro, je cherche à faire un Vlookup pour rechercher des valeurs se situant entre deux bornes et à les coller dans une autre feuille.
J'ai mis en pièce jointe une photo de mon fichier, je recherche donc à copier toute les valeurs comprises (le nom de l'entreprise et le weight estimate) entre "AMUNDI ACTIONS PME" et "AMUNDI EUROPE MICROCAPS" et à les coller dans une autre feuille de mon fichier.
J'espère que j'ai été claire, merci de votre aide.
A bientot.
Gaetan
J'ajoute que'après mise à jour, les bornes changent d'emplacement, elles ne se retrouvent plus au même numéro de ligne:)
Bonjour Gaetan,
var1 = "AMUNDI ACTIONS PME"
var2 = "AMUNDI EUROPE MICROCAPS"
lign1 = Application.Match(var1, Range("A:A"), 0)
lign2 = Application.Match(var2, Range("A:A"), 0)
Range(Cells(lign1, 1), Cells(lign2 - 1, 2)).Copy Sheets("Feuil1").Range("A1")Bonjour SabV,
merci de ton aide:) mais j'ai tjs un pb, VBA me retourne une "error mismatch 13" et je ne comprends pas pourquoi.
Voici mon code et je mets mon fichier en pièce jointe:
Sub cop()
Dim R, F As Range
Dim fin, ligne As Long
Dim c As Variant
Dim P As Variant
Dim Var1 As Variant
Dim Var2 As Variant
Dim lign1 As Variant
Dim lign2 As Variant
ligne = 6
With ThisWorkbook
Sheets("MVTS").Select
Sheets("MVTS").Activate
Worksheets("MVTS").Range("A6:A100").Delete Shift:=xlUp
For Each R In .Sheets("Mvts_data").Range("A:A")
' Recherche d'au mons un doublon
Set F = .Sheets("MVTS").Range("A:A").Find(R.Value)
If Not F Is Nothing Then
' Doublon trouvé, on passe à la ligne suivante de la feuille de PRestations
GoTo FinBoucle
Else
' Doublon non trouvé, on copie l'élément en cours
.Sheets("MVTS").Range("A" & ligne).Value = R.Value
If ligne < 100 Then ligne = ligne + 1
End If
FinBoucle:
Next
End With
Var1 = "AMUNDI ACTIONS PME"
Var2 = "AMUNDI EUROPE MICROCAPS"
lign1 = Application.Match(Var1, Range("A:A"), 0)
lign2 = Application.Match(Var2, Range("A:A"), 0)
Range(Cells(lign1, 1), Cells(lign2 - 1, 2)).Copy Sheets("MVTS").Range("A1")
End Sub
Merci:)
Je ne peux pas télécharge mon fichier je ne sais pas pourquoi, si vous souhaitez des infos supp pour m'aider n'hésitez pas:)
ci joint une photo de l'onglet ou je veux coller mes données tirées de l'onglet "Mvts data".
Bonjour Gaetan,
il faut spécifier le nom des onglets à chaque commandes,
par exemple:
lign1 = Application.Match(var1, Sheets("Feuil1").Range("A:A"), 0)et aussi lors du copier-coller, par exemple:
With Sheets("Feuil1")
.Range(.Cells(lign1, 1), .Cells(lign2 - 1, 2)).Copy Sheets("Feuil2").Range("A1")
End WithBonjour Sab, voilà ce que j'ai mais mon Vlookup ne fonctionne pas, serais-tu d'où cela peut venir?
Merci de ton aide.
Sub Macro3()
Range("A315:W315").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
End Sub
Sub MacroArthur()
'Déclaration des Variables
Dim ws As Worksheet, ws_data As Worksheet
Dim i As Integer, j As Integer
Dim lastrowdata As Integer, lastrow As Integer
Dim li_PME As Integer, li_eurol As Integer, li_europsc As Integer, li_grd As Integer
Dim li_osool As Integer, li_sgeur As Integer, li_sogecm As Integer, li_sogecs As Integer
Dim Ret As Variant
'Affectation feuille
Set ws = ThisWorkbook.Worksheets("MVTS")
Set ws_data = ThisWorkbook.Worksheets("Mvts_data")
'Derniere ligne feuille data
lastrowdata = ws_data.Cells(ws_data.Rows.Count, "A").End(xlUp).Row
'Copie des cellules non vides de la feuille data dans la feuille MVTS
ws.Cells(6, 1).Resize(lastrowdata - 3, 1).Value = ws_data.Range(ws_data.Cells(3, 1), ws_data.Cells(lastrowdata, 1)).Value
'Retrait des doublons des différents fonds.
ws.Range(ws.Cells(6, 1), ws.Cells(lastrowdata + 3, 1)).RemoveDuplicates Columns:=1, Header:=xlNo
'Retrait des noms des fonds
For i = 6 To lastrowdata + 3
If ws.Cells(i, 1).Value = "AMUNDI ACTIONS PME" Then ws.Cells(i, 1).Value = ""
If ws.Cells(i, 1).Value = "AMUNDI FDS EQ EUROLAND SMALL CAP" Then ws.Cells(i, 1).Value = ""
If ws.Cells(i, 1).Value = "AMUNDI FDS EQ EUROPE SMALL CAP" Then ws.Cells(i, 1).Value = ""
If ws.Cells(i, 1).Value = "GRD 12 ACTIONS" Then ws.Cells(i, 1).Value = ""
If ws.Cells(i, 1).Value = "OSOOL EUROPE SMALL CAPS" Then ws.Cells(i, 1).Value = ""
If ws.Cells(i, 1).Value = "SG ACTIONS EUROPE MIDCAP" Then ws.Cells(i, 1).Value = ""
If ws.Cells(i, 1).Value = "SOGECAP ACTIONS MID CAP" Then ws.Cells(i, 1).Value = ""
If ws.Cells(i, 1).Value = "SOGECAP ACTIONS SMALL CAP" Then ws.Cells(i, 1).Value = ""
Next i
'Derniere ligne feuille mvts
lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'Suppression des lignes vides
For i = lastrow To 6 Step -1
If ws.Cells(i, 1).Value = "" Then ws.Rows(i).EntireRow.Delete
Next i
'Récupération des données
li_PME = ws_data.Range(ws_data.Cells(3, 1), ws_data.Cells(lastrowdata, 1)).Find("AMUNDI ACTIONS PME").Row
li_eurol = ws_data.Range(ws_data.Cells(3, 1), ws_data.Cells(lastrowdata, 1)).Find("AMUNDI FDS EQ EUROLAND SMALL CAP").Row
li_europsc = ws_data.Range(ws_data.Cells(3, 1), ws_data.Cells(lastrowdata, 1)).Find("AMUNDI FDS EQ EUROPE SMALL CAP").Row
li_grd = ws_data.Range(ws_data.Cells(3, 1), ws_data.Cells(lastrowdata, 1)).Find("GRD 12 ACTIONS").Row
li_osool = ws_data.Range(ws_data.Cells(3, 1), ws_data.Cells(lastrowdata, 1)).Find("OSOOL EUROPE SMALL CAPS").Row
li_sgeur = ws_data.Range(ws_data.Cells(3, 1), ws_data.Cells(lastrowdata, 1)).Find("SG ACTIONS EUROPE MIDCAP").Row
li_sogecm = ws_data.Range(ws_data.Cells(3, 1), ws_data.Cells(lastrowdata, 1)).Find("SOGECAP ACTIONS MID CAP").Row
li_sogecs = ws_data.Range(ws_data.Cells(3, 1), ws_data.Cells(lastrowdata, 1)).Find("SOGECAP ACTIONS SMALL CAP").Row
'Remplissage PME
For i = 6 To lastrow
Ret = Application.WorksheetFunction.VLookup(ws.Cells(i, 1), ws_data.Range(ws_data.Cells(li_PME + 1, 1), ws_data.Cells(li_eurol - 1, 1)), 2, False)
If Ret <> "" Then
ws.Cells(i, 9) = Ret
End If
Next i
End Sub