Aplicar una macro en varios archivos

Gracias Dany =D. Hay un pequeño problema, es que soy principiante y por eso no entiendo este código; ¿Podrías explicarme rápidamente este código por favor, para saber dónde debo aplicar modificaciones? Te lo agradezco de nuevo.

Hola,

El código de "Dany", si es eficaz, no funcionará, sin embargo, con las versiones de Excel >= 2007...(FileSearch ya no existe en esas versiones...)

Sin embargo, puedes aplicar tu fórmula en todos los archivos de un directorio, abriéndolos, pero sin que se vea en pantalla...

Es una solución "alternativa", sin riesgo, y que funciona siempre....

Un trabajo sobre archivo cerrado es posible, pero requiere un cierto nivel de conocimientos, que a juzgar por el código que acabas de pegar, no parece estar a tu alcance, sin querer ofenderte...

Y bueno, un UP, un sábado por la tarde, después de 1 hora y media de espera....no está bien

Buen fin de semana

Hola,

Con este código, abres los archivos que están en el mismo directorio que el libro que contiene la macro. Por supuesto puedes cambiar el directorio….
Para ello modificas el valor de :

LePath = D:\Users\TonNom\Documents\Excel

Por ejemplo….

De lo que he entendido, en cada archivo, ponemos una fórmula en la hoja 2, y la extendemos a 1000 filas…
Asegúrate de que las pestañas se llamen bien “Feuil1” y “Feuil2”…
Si no, en la “Feuil2”, ¿en qué columna podría encontrarse la última fila llena, para no incrementar la fórmula hasta la fila 1000, sino solo hasta la última fila llena…

En espera de tus precisiones, aquí está el código (que funciona en 2007) :

Sub Modifie_Classeurs() Dim Fich As String, LePath As String Application.ScreenUpdating = False LePath = ActiveWorkbook.Path 'Suponiendo que los archivos están en el mismo directorio que el libro 'si no, pones la ruta de tus archivos Fich = Dir(LePath & "\*.xls") Do While Fich <> "" If Fich <> ActiveWorkbook.Name Then Workbooks.Open Filename:=Fich With Sheets("Feuil2") .Range("G1").FormulaR1C1 = "=Feuil1!RC[8]" .Range("G1").AutoFill Destination:=.Range("G1:G1000"), Type:=xlFillDefault .Columns("G:G").EntireColumn.AutoFit End With Workbooks(Fich).Close True End If Fich = Dir ' classeur siguiente Loop End Sub

Bonne nuit

Re-,

Como se propuso, es obviamente preferible no extender las fórmulas de la columna G más allá de la última celda llena....

Vamos a tomar la hoja 1 como referencia, y la columna "O" de esa hoja...

Entonces reemplazas:

.Range("G1").AutoFill Destination:=.Range("G1:G1000"), Type:=xlFillDefault 

Por:

.Range("G1").AutoFill Destination:=.Range("G1:G" & Sheets("Feuil1").[O65000].End(xlUp).Row), Type:=xlFillDefault

De este modo las fórmulas de la columna G irán hasta la última celda de la columna "O" de la hoja 1

Buen domingo

hola

mira si esto te sirve
Option Explicit
Public dossier
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = ""
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function
Sub Traiter_Dossier()
'Objectif : traiter les fichiers d'un répertoire
'
Dim fs, i, nomfich, FileNumber, specfichier, nbfichiers
Dim fso As New FileSystemObject
dossier = GetDirectory("escoge el directorio a procesar")
If dossier <> "" Then
Set fs = Application.FileSearch
With fs
.LookIn = dossier
.SearchSubFolders = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
nbfichiers = .FoundFiles.Count
MsgBox "Este directorio contiene " & nbfichiers & " archivo(s) que cumplen los criterios."
For i = 1 To nbfichiers
specfichier = .FoundFiles(i)

'*********************
'Poner aquí el procesamiento a realizar
'*********************

Next i
Else
MsgBox "No se encontró ningún archivo."
End If
End With
End If
End Sub

Aquí está la traducción: Aquí está el código de la macro que deseo aplicar a todos mis archivos. Preciso que mis archivos son .xlsx y que estoy bajo Excel 2007. Le agradezco su ayuda.

Sub new_company()
'
' new_company Macro
'

'
Range("AH24").Select
Sheets("Feuil2").Select
Range("G1").Select
ActiveCell.FormulaR1C1 = "=Feuil1!RC[8]"
Range("G1").Select
Selection.AutoFill Destination:=Range("G1:G1000"), Type:=xlFillDefault
Range("G1:G1000").Select
ActiveWindow.ScrollRow = 971
ActiveWindow.ScrollRow = 934
ActiveWindow.ScrollRow = 853
ActiveWindow.ScrollRow = 627
ActiveWindow.ScrollRow = 505
ActiveWindow.ScrollRow = 430
ActiveWindow.ScrollRow = 351
ActiveWindow.ScrollRow = 309
ActiveWindow.ScrollRow = 299
ActiveWindow.ScrollRow = 293
ActiveWindow.ScrollRow = 291
ActiveWindow.ScrollRow = 270
ActiveWindow.ScrollRow = 252
ActiveWindow.ScrollRow = 218
ActiveWindow.ScrollRow = 193
ActiveWindow.ScrollRow = 171
ActiveWindow.ScrollRow = 153
ActiveWindow.ScrollRow = 137
ActiveWindow.ScrollRow = 133
ActiveWindow.ScrollRow = 127
ActiveWindow.ScrollRow = 125
ActiveWindow.ScrollRow = 123
ActiveWindow.ScrollRow = 120
ActiveWindow.ScrollRow = 116
ActiveWindow.ScrollRow = 112
ActiveWindow.ScrollRow = 108
ActiveWindow.ScrollRow = 104
ActiveWindow.ScrollRow = 100
ActiveWindow.ScrollRow = 90
ActiveWindow.ScrollRow = 84
ActiveWindow.ScrollRow = 76
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 64
ActiveWindow.ScrollRow = 56
ActiveWindow.ScrollRow = 54
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 44
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 44
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 33
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 1
Range("G1").Select
Columns("G:G").EntireColumn.AutoFit
End Sub

Eh bien, comment faire cela en les ouvrants ?

Gracias, es estupendo; lo que en realidad quería (me expresé mal) era adaptar el ANCHO de la columna, es decir, que si por ejemplo la celda contiene la palabra "cocodrilo", la columna tome el ancho de la palabra más larga de la columna. Muchas gracias. Feliz domingo también =D