Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Supprimer les "ScrollRow" et "ScrollColumn" dans ma macro

frayer

XLDnaute Nouveau
Bjr,
Dans cette macro générée, je voudrais non pas re-copier dans 3300 lignes(max. d'enregistrements de certains fichiers) les formats et les formules de mon fichier MonPort-EnTetes.xls (car j'ai une flopée de lignes vides qui me restent par la suite) MAIS trouver la dernière ligne de DA_Costs_Tariffs_Report.xls et
1) y re-copier les formats des colonnes A2:Z2 et
2) y re-copies les formules des cellules K2:Z2
et ceci jusqu'à la dernière ligne des données en A2:J2

"Le plus beau port du monde, c'est celui qu'on a pas encore escalé." (Moi)


Sub MonPort_Modif()
'
' MonPort_Modif Macro
'

'Supp Rows 1 > 6
'------------------------------------------
Workbooks.Open Filename:="H:\My Documents\DA_Costs_Tariffs_Report.xls"
Rows("1:6").Select
Selection.Delete Shift:=xlUp
'Supp Column A
'------------------------------------------
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
'Open "En_Tete.xls et copie A1 > Z2 (ligne Tites colonnes + ligne formules
'-------------------------------------------------------------------------
Range("A1").Select
Workbooks.Open Filename:="H:\My Documents\MonPort_EnTete.xls"
Range("A1:Z2").Select
Range("Z2").Activate
Selection.Copy
'Activate "_Reports.xls"....
'---------------------------------------------------
Windows("DA_Costs_Tariffs_Report.xls").Activate
Range("A1").Select
ActiveSheet.Paste
'....et transfert données ex "En_Tete.xls"
'---------------------------------------------------
ActiveWindow.SmallScroll ToRight:=14
Columns("Z:Z").ColumnWidth = 8.29
Columns("Z:Z").Select
Selection.ColumnWidth = 28.71
Range("A2:Z2").Select
Range("Z2").Activate
Application.CutCopyMode = False
Selection.Copy
Rows("2:2").Select
Range("S2").Activate
Application.CutCopyMode = False
Selection.Copy
Application.WindowState = xlMinimized
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Application.CutCopyMode = False
Selection.Copy
Application.WindowState = xlMinimized
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1


Rows("3:3300").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.SmallScroll ToRight:=13
ActiveWindow.LargeScroll ToRight:=-1
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
'Copie des formules K2 > Z2 ....
'-------------------------------------------
Range("Z2").Select
Application.CutCopyMode = False
Range("K2:Z2").Select
Range("Z2").Activate
ActiveWindow.SmallScroll ToRight:=3
Selection.AutoFill Destination:=Range("K2:Z3300"), Type:=xlFillDefault
' ... et copie en K2 > Z3300
'------------------------------------------
Range("K2:Z3300").Select
ActiveWindow.ScrollRow = 827
ActiveWindow.ScrollRow = 820
ActiveWindow.ScrollRow = 809
ActiveWindow.ScrollRow = 805
ActiveWindow.ScrollRow = 784
ActiveWindow.ScrollRow = 754
ActiveWindow.ScrollRow = 681
ActiveWindow.ScrollRow = 587
ActiveWindow.ScrollRow = 477
ActiveWindow.ScrollRow = 370
ActiveWindow.ScrollRow = 299
ActiveWindow.ScrollRow = 233
ActiveWindow.ScrollRow = 220
ActiveWindow.ScrollRow = 213
ActiveWindow.ScrollRow = 211
ActiveWindow.ScrollRow = 209
ActiveWindow.ScrollRow = 207
ActiveWindow.ScrollRow = 205
ActiveWindow.ScrollRow = 203
ActiveWindow.ScrollRow = 201
ActiveWindow.ScrollRow = 200
ActiveWindow.ScrollRow = 194
ActiveWindow.ScrollRow = 185
ActiveWindow.ScrollRow = 181
ActiveWindow.ScrollRow = 170
ActiveWindow.ScrollRow = 158
ActiveWindow.ScrollRow = 134
ActiveWindow.ScrollRow = 108
ActiveWindow.ScrollRow = 91
ActiveWindow.ScrollRow = 80
ActiveWindow.ScrollRow = 72
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 63
ActiveWindow.ScrollRow = 59
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 52
ActiveWindow.ScrollRow = 48
ActiveWindow.ScrollRow = 44
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 38
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 1
Range("Y2").Select
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("A:A").Select
Selection.ColumnWidth = 19
Columns("B:B").ColumnWidth = 20
Columns("D").ColumnWidth = 5.14
Columns("E:E").ColumnWidth = 9.57
Columns("F:F").ColumnWidth = 11.86
ActiveWindow.SmallScroll ToRight:=4
Columns("J:J").ColumnWidth = 5.57
Columns("K:K").ColumnWidth = 5.14
Columns("N:N").Select
Selection.ColumnWidth = 5.43
ActiveWindow.SmallScroll ToRight:=4
Columns("O:O").Select
Selection.ColumnWidth = 9
Selection.ColumnWidth = 8.14
Columns("V:W").Select
Selection.ColumnWidth = 5.86
Columns("X:X").Select
Selection.ColumnWidth = 5.86
ActiveWindow.SmallScroll ToRight:=2
Columns("Y:Y").ColumnWidth = 6
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1

'HIDE COLUMNS
'-----------------------------------------------------
Columns("B:C").Select
Selection.EntireColumn.Hidden = True
Columns("F:G").Select
Selection.EntireColumn.Hidden = True
Columns("I:I").Select
Selection.EntireColumn.Hidden = True
Columns("N:N").Select
Selection.EntireColumn.Hidden = True
Columns("R:R").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.SmallScroll ToRight:=4
Columns("V:W").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 1

'DELETE ROW 2 (DONNEES EXEMPLE)
'------------------------------------------------------
Rows("2:2").Select
Selection.Delete Shift:=xlUp

'>=====================================================
'>Sub MonPort_TotFreeze()
'
' MonPort_TotFreeze Macro
'
'
ActiveWindow.SplitRow = 0.916666666666667
ActiveWindow.SplitColumn = 9.97802197802198
Columns("A:A").ColumnWidth = 19.14
Columns("J:J").ColumnWidth = 7.86
ActiveWindow.SplitColumn = 9.95
ActiveWindow.FreezePanes = True
'
'Save under "MonPort_ToBeFilled"
ActiveWorkbook.SaveAs Filename:= _
"H:\My Documents\00_03_Agency Cost Setting\For Brazil Ports\All_Ports_Filling(March)\MonPort_ToBeFilled.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False


Range("O2").Select
End Sub
 
Trier par date Trier par votes

Etienne2323

XLDnaute Impliqué
Re : Supprimer les "ScrollRow" et "ScrollColumn" dans ma macro

Salut frayer,
tout d'abord, je dois t'avouer que je n'ai pas compris ce que tu cherchais réellement à faire. La première chose à faire serait d'abord de déposer une fichier anonymisé en pièce jointe en nous explicant exactement ce que tu cherches à faire.

Ensuite, quand tu déposes un code comme ça, utilise les balises de code (le #).

J'ai donc essayé de passer le couperet dans le superflu dans ta macro. Toutefois, je n'ai fait aucune modification sur le fonctionnement.

Lorsque tu auras déposé le fichier, on pourra y jeter un coup d'oeil et voir ce qu'on peut faire.

Code: 
Sub MonPort_Modif()
'
' MonPort_Modif Macro
'
Application.ScreenUpdating = False
'Supp Rows 1 > 6
'------------------------------------------
Workbooks.Open Filename:="H:\My Documents\DA_Costs_Tariffs_Report.xls"
Rows("1:6").Delete Shift:=xlUp
'Supp Column A
'------------------------------------------
Columns("A:A").Delete Shift:=xlToLeft
'Open "En_Tete.xls et copie A1 > Z2 (ligne Tites colonnes + ligne formules
'-------------------------------------------------------------------------
Workbooks.Open Filename:="H:\My Documents\MonPort_EnTete.xls"
Range("A1:Z2").Copy
'Activate "_Reports.xls"....
'---------------------------------------------------
Windows("DA_Costs_Tariffs_Report.xls").Activate
Range("A1").Select
ActiveSheet.Paste
'....et transfert données ex "En_Tete.xls"
'---------------------------------------------------
Columns("Z:Z").ColumnWidth = 28.71
Range("A2:Z2").Copy

Rows("3:3300").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Copie des formules K2 > Z2 ....
'-------------------------------------------
Range("K2:Z2").AutoFill Destination:=Range("K2:Z3300"), Type:=xlFillDefault
' ... et copie en K2 > Z3300
'------------------------------------------

Columns("A:A").ColumnWidth = 19
Columns("B:B").ColumnWidth = 20
Columns("D").ColumnWidth = 5.14
Columns("E:E").ColumnWidth = 9.57
Columns("F:F").ColumnWidth = 11.86
Columns("J:J").ColumnWidth = 5.57
Columns("K:K").ColumnWidth = 5.14
Columns("N:N").ColumnWidth = 5.43
Columns("O:O").ColumnWidth = 9
Columns("V:W").ColumnWidth = 5.86
Columns("X:X").ColumnWidth = 5.86
Columns("Y:Y").ColumnWidth = 6

'HIDE COLUMNS
'-----------------------------------------------------
Columns("B:C").EntireColumn.Hidden = True
Columns("F:G").EntireColumn.Hidden = True
Columns("I:I").EntireColumn.Hidden = True
Columns("N:N").EntireColumn.Hidden = True
Columns("R:R").EntireColumn.Hidden = True
Columns("V:W").EntireColumn.Hidden = True


'DELETE ROW 2 (DONNEES EXEMPLE)
'------------------------------------------------------
Rows("2:2").Delete Shift:=xlUp

'>================================================ =====
'>Sub MonPort_TotFreeze()
'
' MonPort_TotFreeze Macro
'
'
ActiveWindow.SplitRow = 0.916666666666667
ActiveWindow.SplitColumn = 9.97802197802198
Columns("A:A").ColumnWidth = 19.14
Columns("J:J").ColumnWidth = 7.86
ActiveWindow.SplitColumn = 9.95
ActiveWindow.FreezePanes = True
'
'Save under "MonPort_ToBeFilled"
ActiveWorkbook.SaveAs Filename:= _
"H:\My Documents\00_03_Agency Cost Setting\For Brazil Ports\All_Ports_Filling(March)\MonPort_ToBeFilled. xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Application.Goto Range("O2"), True

End Sub

Cordialement,

Étienne
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

L
  • Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
655
fanfan38
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
2 K
fanou06
F
  • Question
XL 2016 Erreur 1004 - Erreur définie par l'application ou par l'objet
Réponses
4
Affichages
544
Philou0607
J
  • Question
XL 2019 Borné une extraction par date
2
Réponses
22
Affichages
2 K
jui42
J
  • Résolu(e)
XL 2021 recherche supprimer les espaces '"si valeur cherchée est numérique" sinon NON
Réponses
7
Affichages
381
Usine à gaz
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
400
M@xu3L
M
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
312
Compte Supprimé 979
C
  • Résolu(e)
XL 2016 Changer de feuille dans une macro
2
Réponses
28
Affichages
3 K
Staple1600
  • Résolu(e)
Microsoft 365 compter le temps passé sur une ligne et cumuler tous les temps passés
2
Réponses
17
Affichages
1 K
Usine à gaz
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…