Hola a todos:
Quien podría ayudarme con lo siguiente: En Excel 2003 hago una consolidación
de todos mis archivos de Excel de determinada carpeta en otro archivo de
Excel y funciona de maravilla, pero ahora que aplico lo mismo en Excel 2007,
ya no funciona el código como debería. Les envío el código como lo tengo y
espero puedan ayudarme.
Gracias: Guillermo.
Sub ConsolidarSlds()
'
' ConsolidarSlds Macro
' Macro grabada el 08/09/2002 por Guillermo Cebreros Sierra
'
' Acceso directo: CTRL+t
'
Dim miSaldo As Excel.Application
On Error Resume Next
With miSaldo
Dim miHoja As Worksheet
Set miHoja = Worksheets.Add
ChDir "C:\Cebreros\ExpeDiente\Estados de Cuenta"
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Consolidar Saldos").Delete
miHoja.Name = "Consolidar Saldos"
Range("A1").Select
Selection.Consolidate Sources:="'[*.xls]Saldos'!R4C1:R10C2", Function:= _
xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=True
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Range("A1").Select
ActiveCell.FormulaR1C1 = "Cuenta"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Paciente"
Range("A1").Select
Selection.AutoFormat Format:=xlRangeAutoFormatList1, Number:=True,
Font:= _
True, Alignment:=True, Border:=True, Pattern:=True, Width:=True
End With
On Error Resume Next
With miSaldo
Dim miHoja2 As Worksheet
Set miHoja2 = Worksheets.Add
ChDir "\\Clínica\C\Cebreros\ExpeDiente\Estados de Cuenta"
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Consolidar Saldos").Delete
miHoja2.Name = "Consolidar Saldos"
Range("A1").Select
Selection.Consolidate Sources:="'[*.xls]Saldos'!R4C1:R10C2", Function:= _
xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=True
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Range("A1").Select
ActiveCell.FormulaR1C1 = "Cuenta"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Paciente"
Range("A1").Select
Selection.AutoFormat Format:=xlRangeAutoFormatList1, Number:=True,
Font:= _
True, Alignment:=True, Border:=True, Pattern:=True, Width:=True
End With
End Sub
Leer las respuestas