Re : Transposer des données selon des N° de folios
Bonjour à toutes et tous
J'ai amélioré mon code, que voici:
Sub Reperes4Col()
Dim Folio As Variant
Folio = 1
Application.ScreenUpdating = False
'Effacer les données existantes en colonnes A-B-C-D-E-F
Columns("A:F").Select
Selection.ClearContents
Range("A1").Select
''Importer les données
' Workbooks.Open Filename:="D:\Repères P Peleija\Lien_Schema_Ndt.XLS"
' Range("A2:B10000").Select
' Selection.Copy
' Windows("Transposition par folios.xlsm").Activate
' ActiveSheet.Paste
' Range("A1").Select
' Windows("Lien_Schema_Ndt.XLS").Activate
' Range("A1").Select
' Application.CutCopyMode = False
' ActiveWindow.Close
Rep_Folio = ActiveCell.Offset(0, 0).Value
While Cells(Folio, 2).Value <> ""
ActiveCell(Folio, 3).FormulaR1C1 = _
"=OFFSET(R1C2,(ROW()-1)*4+INT((COLUMN()-3)),MOD(COLUMN()-3,1))"
ActiveCell(Folio, 4).FormulaR1C1 = _
"=OFFSET(R1C2,(ROW()-1)*4+INT((COLUMN()-3)),MOD(COLUMN()-3,1))"
ActiveCell(Folio, 5).FormulaR1C1 = _
"=OFFSET(R1C2,(ROW()-1)*4+INT((COLUMN()-3)),MOD(COLUMN()-3,1))"
ActiveCell(Folio, 6).FormulaR1C1 = _
"=OFFSET(R1C2,(ROW()-1)*4+INT((COLUMN()-3)),MOD(COLUMN()-3,1))"
Folio = Folio + 1
Wend
'Transformer les formules en données texte
Columns("C:F").Select
Selection.Copy
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
'Effacer les 0
ActiveCell.Offset(0, 2).Range("A1").Select
Cells.Find(What:="0", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Activate
ActiveCell.Range("A1
10000").Select
Selection.ClearContents
Range("A1").Select
''Supprimer les colonnes A et B dont nous n'avons plus besoin
' Columns("A:B").Select
' Selection.Delete Shift:=xlToLeft
' Range("A1").Select
Application.ScreenUpdating = True
End Sub
Mais incapable de trouver la solution pour qu'à chaque changement de folio de la colonne A, celui-ci se positionne sur la première étiquette.
Votre aide me serait très précieuse.
Merci