Copier et renommer onglet avec VBA
Bonjour
Je suis novice dans le VBA sous Excel.
1. Sur onglet stock extraire une liste des articles sans mouvement entrée ou sortie colonne N et O depuis 3 ans, et copier le tout dans un nouvel onglet qui se nommerais automatiquement suivant la date du jour ou l'on fait cette macro.
je sais que je demande beaucoup mais je galéré beaucoup la dessus
Merci
Bonjour Acylag et bienvenu, bonjour le forum,
Extraire c'est Couper/Coller ou Copier/coller ? En attendant je commence à réfléchir sur ton problème...
Re,
Visiblement je réfléchis plus vite que tu ne réponds
Le code ci-dessous extrait les données mais les laisse dans le stock (copier/coller). Si tu veux les supprimer du stock (couper/coller) il faudra revoir...
Le code :
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Stock)
Dim OE As Worksheet 'déclare la variable OE (Onglet de l'Extraction)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim NC As Byte 'déclare la variable NC (Nombre de Colonnes)
Dim DA As Long 'déclare la variable DA (Date d'Aujourd'hui))
Dim DE As Long 'déclare la variable DE (Date des Entrées)
Dim DS As Long 'déclare la variable DS (Date des Sorties)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
DA = CLng(DateSerial(Year(Date), Month(Date), Day(Date))) 'définit la date DA (en entier long)
Set OS = Worksheets("Stock ") 'définit l'onglet OS (attention il y a un espace à la fin dans le nom...)
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV
'définit la date des entrées DE + 3 ans (en entier long)
DE = CLng(DateSerial(Year(TV(I, 15)) + 3, Month(TV(I, 15)), Day(TV(I, 15))))
'définit la date des sorties DS + 3 ans (en entier long)
DS = CLng(DateSerial(Year(TV(I, 14)) + 3, Month(TV(I, 14)), Day(TV(I, 14))))
If Not DE > DA And Not DS > DA Then 'condition la la date des entrée ou la date des sortie n'est pas supérieure à DA
ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des ligne TL (autant de lignes que TV a de colonnes, K colonnes)
For L = 1 To NC 'boucle 2 : sur toutes les colonnes L du tableau des valeurs TV
TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (=> Transposition)
Next L 'prochaine colonne de la boucle 2
K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
End If 'fin de la conditoin
Next I 'prochaine ligne de la boucle 1
If K > 1 Then 'condition : si K est supérieure à 1
Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet en dernière position
Set OE = ActiveSheet 'défini l'onglet OE
OE.Name = Format(DA, "dd_mmmm_yyyy") 'renomme l'onglet OE
'renvoie dans A1 redimensionnée de l'onglet OE, la ligne 1 de TV
OE.Range("A1").Resize(1, NC).Value = Application.Index(TV, 1)
'renvoie dans A2 redimensionnée de lónglet OE, le tableau TL transposé
OE.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
End If 'fin de la ondition
End Sub
Merci beaucoup pour ce code et votre rapidité, cela fonctionne très bien je vais pouvoir faire le reste seul
Cordialement