Besoin d'un petit nettoyage

Le
rthompson
Bonjour à toutes et tous
Et merci à ceux qui m'ont aidé jusqu'ici

Ci-dessous ma petite usine à gaz
Je suis persuadé qu'il y a moyen de la nettoyer un peu, beaucoup,
passionément
Il s'agit de faire les mêmes opérations sur quatre fichiers séparés

Et à l'avenir il pourrait en avoir jusqu'à quinze
Ce qu'il faut faire est copier toute l'info (sauf la ligne 1, qui sont les
titres)
de chaque "Sheet1" de chaque fichier et coller cette info à la suite du
précédent

Si l'un de vous a le courage et la gentillesse

D'avance merci

Rex

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


Sub Open_up()
' First clear all the contents of the sheet
Range("a2:bb2000").ClearContents
Application.ScreenUpdating = False

' Open Max's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosESP
Max.xls ")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in column
A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
_
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Max's file
Workbooks("ESP Max.xls").Close

' This is the same for Alex, but we have to disable the error messages
' because of his read only bit

Application.DisplayAlerts = False
' Open Alex's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosESP
Alex.xls ")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in column
A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
_
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Max's file
Workbooks("ESP Alex.xls").Close
' And we must reset the alerts displaying
Application.DisplayAlerts = True

' Open Pauline's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosESP
Pauline.xls ")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in column
A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
_
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Pauline's file
Workbooks("ESP Pauline.xls").Close

' Open Lionel's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosESP
Lionel .xls")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in column
A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
_
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Lionel's file
Workbooks("ESP Lionel .xls").Close

' now we reformat the columns to make them readable

Cells.Select
Selection.Columns.AutoFit
Selection.RowHeight = 18
Application.ScreenUpdating = True


End Sub
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Corto
Le #17680701
Bonjour rthompson,
Tu peux déjà supprimer tous les Select inutiles
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy


Sheets("Sheet1").Range("A2:aX600").Copy
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
SkipBlanks:úlse, Transpose:úlse


Set CIBLE = ['[ESP-Master.xls]Master'!A1].CurrentRegion
CIBLE.Offset(CIBLE.Rows.Count).Cells(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats

Corto

rthompson a écrit :
Bonjour à toutes et tous
Et merci à ceux qui m'ont aidé jusqu'ici

Ci-dessous ma petite usine à gaz
Je suis persuadé qu'il y a moyen de la nettoyer un peu, beaucoup,
passionément
Il s'agit de faire les mêmes opérations sur quatre fichiers sépar és

Et à l'avenir il pourrait en avoir jusqu'à quinze
Ce qu'il faut faire est copier toute l'info (sauf la ligne 1, qui sont les
titres)
de chaque "Sheet1" de chaque fichier et coller cette info à la suite du
précédent

Si l'un de vous a le courage et la gentillesse

D'avance merci

Rex

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


Sub Open_up()
' First clear all the contents of the sheet
Range("a2:bb2000").ClearContents
Application.ScreenUpdating = False

' Open Max's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosE SP
Max.xls ")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in co lumn
A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:= xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:= xlNone,
_
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Max's file
Workbooks("ESP Max.xls").Close

' This is the same for Alex, but we have to disable the error messages
' because of his read only bit

Application.DisplayAlerts = False
' Open Alex's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosE SP
Alex.xls ")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in co lumn
A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:= xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:= xlNone,
_
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Max's file
Workbooks("ESP Alex.xls").Close
' And we must reset the alerts displaying
Application.DisplayAlerts = True

' Open Pauline's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosE SP
Pauline.xls ")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in co lumn
A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:= xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:= xlNone,
_
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Pauline's file
Workbooks("ESP Pauline.xls").Close

' Open Lionel's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosE SP
Lionel .xls")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in co lumn
A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:= xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:= xlNone,
_
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Lionel's file
Workbooks("ESP Lionel .xls").Close

' now we reformat the columns to make them readable

Cells.Select
Selection.Columns.AutoFit
Selection.RowHeight = 18
Application.ScreenUpdating = True


End Sub
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx





isabelle
Le #17680991
bonjour Rex,

Sub Open_up()
' First clear all the contents of the sheet
Range("a2:bb2000").ClearContents
Application.ScreenUpdating = False

liste = Array("ESP Max.xls", "ESP Alex.xls", "ESP Pauline.xls", "Lionel .xls")
For Each f In liste
' Open Max's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macros" & f)
Sheets("Sheet1").Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in columnA
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Max's file
Workbooks(f).Close
Next
' now we reformat the columns to make them readable
With Cells
.Columns.AutoFit
.RowHeight = 18
End With
Application.ScreenUpdating = True
End Sub

isabelle

rthompson a écrit :
Bonjour à toutes et tous
Et merci à ceux qui m'ont aidé jusqu'ici

Ci-dessous ma petite usine à gaz
Je suis persuadé qu'il y a moyen de la nettoyer un peu, beaucoup,
passionément
Il s'agit de faire les mêmes opérations sur quatre fichiers séparés

Et à l'avenir il pourrait en avoir jusqu'à quinze
Ce qu'il faut faire est copier toute l'info (sauf la ligne 1, qui sont les
titres)
de chaque "Sheet1" de chaque fichier et coller cette info à la suite du
précédent

Si l'un de vous a le courage et la gentillesse

D'avance merci

Rex

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


Sub Open_up()
' First clear all the contents of the sheet
Range("a2:bb2000").ClearContents
Application.ScreenUpdating = False

' Open Max's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosESP
Max.xls ")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in column
A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
_
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Max's file
Workbooks("ESP Max.xls").Close

' This is the same for Alex, but we have to disable the error messages
' because of his read only bit

Application.DisplayAlerts = False
' Open Alex's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosESP
Alex.xls ")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in column
A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
_
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Max's file
Workbooks("ESP Alex.xls").Close
' And we must reset the alerts displaying
Application.DisplayAlerts = True

' Open Pauline's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosESP
Pauline.xls ")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in column
A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
_
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Pauline's file
Workbooks("ESP Pauline.xls").Close

' Open Lionel's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosESP
Lionel .xls")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in column
A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
_
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Lionel's file
Workbooks("ESP Lionel .xls").Close

' now we reformat the columns to make them readable

Cells.Select
Selection.Columns.AutoFit
Selection.RowHeight = 18
Application.ScreenUpdating = True


End Sub
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx




JPMonnier
Le #17682891
Bonjour, Isabelle, Corto, Rex
Pour faire la manip sur tous les fichiers de ton repertoire modifie :
liste = Array("ESP Max.xls", "ESP Alex.xls", "ESP Pauline.xls", "Lionel
.xls")
For Each f In liste

par

Rep = "C:AA-Rex-DataPaperviewgabors files for macros"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set Dossier = objFSO.GetFolder(Rep)
If (Dossier.Files.Count > 0) Then
For Each FICHIER In Dossier.Files

C'est un peu plus long, mais tu peux traiter de 1 à xxxx fichiers
Si ton fichier ESP-Master ne se trouve pas dans le même répertoire, supprime
les 2 lignes marquées en fin de ligne : 'Facultatif

Note que seuls les fichiers à traiter doivent se trouver dans le répertoire
Tiens compte également du post de Corto
Pardon Isabelle, l'avantage plutôt qu'Array est d'éviter de modifier la
ligne Aray avec l'évolution des fichiers

Sub Open_up()
Rep = "C:AA-Rex-DataPaperviewgabors files for macros"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set Dossier = objFSO.GetFolder(Rep)
If (Dossier.Files.Count > 0) Then
For Each FICHIER In Dossier.Files
If Fichier <> Rep & "ESP-Master.xls" Then ' Facultatif
' Open Max's file copies all the data
Workbooks.Open FICHIER
Sheets("Sheet1").Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in
columnA
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Max's file
Workbooks(f).Close
Next
' now we reformat the columns to make them readable
With Cells
.Columns.AutoFit
.RowHeight = 18
End With
Application.ScreenUpdating = True
End If ' Facultatif
End If
End Sub


"isabelle" a écrit dans le message de
news:
bonjour Rex,

Sub Open_up()
' First clear all the contents of the sheet
Range("a2:bb2000").ClearContents
Application.ScreenUpdating = False

liste = Array("ESP Max.xls", "ESP Alex.xls", "ESP Pauline.xls", "Lionel
.xls")
For Each f In liste
' Open Max's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macros" & f)
Sheets("Sheet1").Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in
columnA
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Max's file
Workbooks(f).Close
Next
' now we reformat the columns to make them readable
With Cells
.Columns.AutoFit
.RowHeight = 18
End With
Application.ScreenUpdating = True
End Sub

isabelle

rthompson a écrit :
Bonjour à toutes et tous
Et merci à ceux qui m'ont aidé jusqu'ici

Ci-dessous ma petite usine à gaz
Je suis persuadé qu'il y a moyen de la nettoyer un peu, beaucoup,
passionément
Il s'agit de faire les mêmes opérations sur quatre fichiers séparés

Et à l'avenir il pourrait en avoir jusqu'à quinze
Ce qu'il faut faire est copier toute l'info (sauf la ligne 1, qui sont
les titres)
de chaque "Sheet1" de chaque fichier et coller cette info à la suite du
précédent

Si l'un de vous a le courage et la gentillesse

D'avance merci

Rex

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


Sub Open_up()
' First clear all the contents of the sheet
Range("a2:bb2000").ClearContents
Application.ScreenUpdating = False

' Open Max's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosESP
Max.xls ")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in
column A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats,
Operation:=xlNone, _
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Max's file
Workbooks("ESP Max.xls").Close

' This is the same for Alex, but we have to disable the error messages
' because of his read only bit

Application.DisplayAlerts = False
' Open Alex's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosESP
Alex.xls ")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in
column A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats,
Operation:=xlNone, _
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Max's file
Workbooks("ESP Alex.xls").Close
' And we must reset the alerts displaying
Application.DisplayAlerts = True

' Open Pauline's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosESP
Pauline.xls ")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in
column A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats,
Operation:=xlNone, _
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Pauline's file
Workbooks("ESP Pauline.xls").Close

' Open Lionel's file copies all the data
Workbooks.Open ("C:AA-Rex-DataPaperviewgabors files for macrosESP
Lionel .xls")
Sheets("Sheet1").Select
ActiveSheet.Range("A2:aX600").Copy
' Activate the Master sheet and past as from the first empty cell in
column A
Windows("ESP-Master.xls").Activate
Sheets("Master").Select
Range("A2").Select
If Range("A1").End(xlDown) = Range("a65535") Then
Range("a65535").End(xlUp).Offset(1, 0).Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:úlse, Transpose:úlse
Selection.PasteSpecial Paste:=xlPasteFormats,
Operation:=xlNone, _
SkipBlanks:úlse, Transpose:úlse
' This avoids the save memory message
Application.CutCopyMode = False
' This closes Lionel's file
Workbooks("ESP Lionel .xls").Close

' now we reformat the columns to make them readable

Cells.Select
Selection.Columns.AutoFit
Selection.RowHeight = 18
Application.ScreenUpdating = True


End Sub
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx




Publicité
Poster une réponse
Anonyme