Re : VBA : Créer un classeur, lancer une macro dessus, copier les résultats & le supp
Bonjour,
Merci de ta réponse.
Voici ma macro avec les explications qui vont avec :
Sub ACTUALISERBASE()
Partie en cours d'essai pour créer un classeur et copier les données depuis classeur source
FichierOùCopier = ActiveWorkbook.Name
Application.Workbooks.Add
FichierOùColler = ActiveWorkbook.Name
Workbooks(FichierOùCopier).Activate
Sheets("UVCI ").Select
Sheets("UVCI ").Copy After:=Workbooks(FichierOùColler).Sheets(3)
Workbooks(FicherOùColler).Select
Sheets("UVCI ").Select
ActiveSheet.Name = "SUPPORT"
Sheets("Feuil1").Select
ActiveSheet.Name = "UVCI "
Sheets("UVCI ").Select
Application.ScreenUpdating = False
Workbooks(FichierOùColler).Select
Sheets("UVCI ").Select
Ici, ma macro. Elle supprime les doublons, reconditionne le tableau que je souhaite et met en forme sauf que des données en colonne K sont perdues à cette étape et donc, de ce fait, je crée une sauvegarde avant de la supprimer dans un classeur vierge
ActiveSheet.Range("$A$2:$L$" & Range("C" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
, 7, 8, 9, 10, 11, 12), Header:=xlNo
derLn = Range("C" & Rows.Count).End(xlUp).Row
Set tabloCol = Range("C3:C" & derLn)
Set tablo = Range("A3:N" & derLn)
ReDim v(derLn - 2, 14)
I = 0
For Each c In tabloCol
If c.Offset(0, -2).Value = 1 Then
For j = 0 To 13
v(I, j) = Cells(c.Row, 1 + j)
Next j
I = I + 1
End If
Next c
tablo.Select
Selection = v
derLn = Range("C" & Rows.Count).End(xlUp).Row
ReDim w((derLn - 2) * 14, 14)
For I = 0 To derLn - 3
For n = 0 To 13
k = n + 1
Label = Choose(k, 1, 1.2, 2, 2.2, 3, 3.2, 4, 5, 6, 7, 7.5, 8, 9, 10)
For j = 0 To 13
If j = 0 Then
w(I * 14 + n, j) = Label 'v(i, j)
Else
w(I * 14 + n, j) = v(I, j)
End If
Next j
Next n
Next I
Range("A3:N" & (derLn - 2) * 14 + 2) = w
Je complete ma base car des formules textes sont adaptées à chaque label
Sheets("UVCI ").Select
Dim finalrow As Long
finalrow = Cells(Rows.Count, "C").End(xlUp).Row
Application.CutCopyMode = False
Range("J3").Select
ActiveCell.FormulaR1C1 = "='reference lineaire'!R[1]C[-4]"
Range("J3").Select
Selection.AutoFill Destination:=Range("J3:L3"), Type:=xlFillDefault
Range("J3:L3").Select
Selection.AutoFill Destination:=Range("J3:L15"), Type:=xlFillDefault
Range("J3:L15").Select
Selection.AutoFill Destination:=Range("J3:L16"), Type:=xlFillDefault
Range("J3:L16").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.SmallScroll Down:=6
Selection.Copy
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("J3:L" & finalrow), Type:=xlFillCopy
Range("J3:L" & finalrow).Select
J'ai lancé ma macro sur ma page "UVCI " et donc vu que j'ai des données qui ont été effacé dans ma colonne M et N, je les recherche dans ma feuille "SUPPORT" par l'intermédiaire d'un recherchev
finalrow = Range("C1048576").End(xlUp).Row
Workbooks(FichierOùColler).Select
Sheets("SUPPORT").Select
Columns("M:M").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M3").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-12],RC[-11],RC[-10])"
Range("M3").Select
Selection.AutoFill Destination:=Range("M3:M" & finalrow)
Workbooks(FichierOùColler).Select
Sheets("UVCI ").Select
Range("O3").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-14],RC[-13],RC[-12])"
Range("O3").Select
Selection.AutoFill Destination:=Range("O3:O" & finalrow)
Range("M3").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[2],SUPPORT!C:C[1],2,FALSE),""ERREUR"")"
Range("M3").Select
Selection.AutoFill Destination:=Range("M3:M" & finalrow)
Je copie et colle en valeurs afin d'oter les formules
Columns("M:M").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("N3").Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-2]"
Range("N3").Select
Selection.AutoFill Destination:=Range("N3:N" & finalrow)
Columns("N:N").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Cette partie est fausse (à la base je pensais juste ajouter une feuille mais vu que je n'ai pas les ressources mémoires suffisantes, il me faut créer le nouveau classeur comme décrit au-dessus. Donc cette étape du code est faussée
Sheets("SUPPORT").Select
ActiveWindow.SelectedSheets.Delete
Sheets("UVCI ").Select
Range("O3:O" & finalrow).ClearContents
un essai pour récupérer ma feuille de données "UVCI" de mon classeur créé vers mon classeur source
Workbooks(FichierOùColler).Activate
Sheets("UVCI ").Select
Range("A3:N" & finalrow).Copy
Workbooks(FichierOùCopier).Activate
Sheets("UVCI ").Select
Range("A3").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
Cells(3, 1).Select
End Sub