Faire fonctionner un code sans qu'il ne connaisse le nom de la feuille

Bonjour le forum, bonjour tout le monde,

Je dois convertir un tableau sous un autre format et j'ai réussi à trouver tant bien que mal un code qui fonctionne. Le seul problème est que je devrais le faire fonctionner sans qu'il ne connaisse le nom de la feuille ("PositionsAsia" puisque son nom est susceptible de changer régulièrement contrairement au format du tableau qui peut seulement s'étendre en longueur). Il faudrait également que le nouveau tableau remplace le tableau initial sans créer une autre feuille.

Je me permets également de joindre une copie du fichier

Option Explicit
Sub test()

Dim nbre_lignes_max As Long
Dim ligne_cours As Long

Dim debut As Date
Dim fin As Date
Dim delai As Date

Application.ScreenUpdating = False

debut = Time

On Error Resume Next
Sheets("PositionsAsia").ShowAllData
On Error GoTo 0

Sheets("PositionsAsia").Columns("A:XFD").EntireColumn.Hidden = False
Sheets("PositionsAsia").Rows("1:1048576").EntireRow.Hidden = False

On Error Resume Next
Application.DisplayAlerts = False
Sheets("destination").Delete
Application.DisplayAlerts = True
On Error GoTo 0

Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Name = "destination"

Sheets("destination").Range("A1") = "Contract"
Sheets("destination").Range("B1") = "Crude"
Sheets("destination").Range("C1") = "Brent"

nbre_lignes_max = Sheets("PositionsAsia").Range("B1048576").End(xlUp).Row

For ligne_cours = 2 To nbre_lignes_max

    Sheets("PositionsAsia").Range("D" & ligne_cours) = Sheets("PositionsAsia").Range("B" & ligne_cours) & " | " & Sheets("PositionsAsia").Range("A" & ligne_cours)
    Sheets("PositionsAsia").Range("E" & ligne_cours) = Sheets("PositionsAsia").Range("C" & ligne_cours)

Next ligne_cours

Sheets("destination").Range("A2:A" & nbre_lignes_max).Value = Sheets("PositionsAsia").Range("B2:B" & nbre_lignes_max).Value

Sheets("destination").Range("A1:A" & nbre_lignes_max).RemoveDuplicates Columns:=1, Header:=xlYes

nbre_lignes_max = Sheets("destination").Range("A1048576").End(xlUp).Row

Sheets("destination").Sort.SortFields.Clear
Sheets("destination").Sort.SortFields.Add Key:=Sheets("destination").Range("A2:A" & nbre_lignes_max), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With Sheets("destination").Sort

    .SetRange Sheets("destination").Range("A1:A" & nbre_lignes_max)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply

End With

Sheets("destination").Range("B2").Formula = "=IFERROR(IF(LEN(VLOOKUP(A2&"" | ""&B$1,PositionsAsia!D:E,2,FALSE))>0,VLOOKUP(A2&"" | ""&B$1,PositionsAsia!D:E,2,FALSE),""""),"""")"
Sheets("destination").Range("C2").Formula = "=IFERROR(IF(LEN(VLOOKUP(A2&"" | ""&C$1,PositionsAsia!D:E,2,FALSE))>0,VLOOKUP(A2&"" | ""&C$1,PositionsAsia!D:E,2,FALSE),""""),"""")"

Sheets("destination").Range("B2:C2").AutoFill Destination:=Sheets("destination").Range("B2:C" & nbre_lignes_max)

Sheets("destination").Range("A2:C" & nbre_lignes_max).Value = Sheets("destination").Range("A2:C" & nbre_lignes_max).Value

nbre_lignes_max = Sheets("PositionsAsia").Range("B1048576").End(xlUp).Row
Sheets("PositionsAsia").Range("D2:E" & nbre_lignes_max).Clear

fin = Time

delai = fin - debut

Application.ScreenUpdating = True

MsgBox "Traitement terminé" & vbNewLine & vbNewLine & "Début:" & Chr(9) & debut & vbNewLine & "Fin:" & Chr(9) & fin & vbNewLine & "Délai:" & Chr(9) & delai, vbInformation, "Fin de tâche"

End Sub

Bonjour

A tester remplacer dans ton code

PositionsAsia 

Par Feuil2
Cordialement

bonjour,

sans qu'il ne connaisse le nom de la feuille ("PositionsAsia" puisque son nom est susceptible de changer régulièrement

tu dis qu'il peux changer mais tu l'écris en dure dans ton code!

    Sheets("PositionsAsia").Range("D" & ligne_cours) = Sheets("PositionsAsia").Range("B" & ligne_cours) & " | " & Sheets("PositionsAsia").Range("A" & ligne_cours)
    Sheets("PositionsAsia").Range("E" & ligne_cours) = Sheets("PositionsAsia").Range("C" & ligne_cours)

je t'invite à utiliser une variable objet qui pointe sur ta source et tan que tu y es une sur ta Destination!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Source As Worksheet, Destination As Worksheet

Set Source = Sheets("PositionsAsia")
On Error Resume Next
Source.ShowAllData
On Error GoTo 0

'...

Source.Columns("A:XFD").EntireColumn.Hidden = False
Source.Rows("1:1048576").EntireRow.Hidden = False

On Error Resume Next
Application.DisplayAlerts = False
Sheets("destination").Delete
Application.DisplayAlerts = True
On Error GoTo 0

Set Destination = Sheets.Add(After:=Sheets(Sheets.Count))
Destination.Name = "destination"
'...
End Sub

l’inconnu maintenant c'est le nom de la feuille PositionsAsia qui peux changer de nom!

je t'invites à ajouter à ton classeur une feuille de configuration ou tu inscrira son nom!

Set Source = Sheets(Sheets("Config").Range("A1"))
@Joco7915
je ne suis pas partisan de cette forme d'écriture mais ça marche!

Merci pour vos retour c'est génial je me rapproche de quelque chose qui marche parfaitement. Il reste un détail encore un peu bloquant, comment pourrait-on faire pour additionner et supprimer les doublons (sans tableau croisé dynamique) ? Notamment pour transformer les deux lignes Crude H2021en une seule ligne qui donnerait -24 ?

capture d ecran 2020 12 09 a 13 56 42
Rechercher des sujets similaires à "fonctionner code connaisse nom feuille"