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"))
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 ?