Copiar celdas de entre dos .xls
Publicado por Jorge (2 intervenciones) el 26/12/2008 10:50:57
Hola a todos, necesito en estas fechas tan entrañables vuestra inestimable ayuda.
tengo un codigo en visual basic para excel que me habre todos los archivos .xls de una carpeta y me copia unas determinadas filas de cada archivo en una hoja de calculo nueva. Pero la funcion que me hace esta copia no consigo que haga lo que yo necesito, que es copiar unas determninadas celdas de cada archivo (las mismas en todos los archivos .xls) en filas de mi hoja de calculo destino, y asi poder gestionar todos los .xls desde una sola hoja de calculo, este es el codigo:
****************************************************************************************
Sub AbriryCopiar()
' La carpeta con los archivos para abrir.
Const strSendero As String = "D:UN52617"
Dim varArchivo As Variant, i%
Dim fs As FileSearch
Set fs = Application.FileSearch
' Cambie la hilera "xxx*.xls" para que sea una
' mascara que devolverá los archivos deseados.
' Si desea todos, borre la línea.
With fs
.NewSearch
.LookIn = strSendero
.SearchSubFolders = False
'.FileType = msoFileTypeExcelWorkbooks
.Filename = "*.xls"
If .Execute > 0 Then
Application.ScreenUpdating = False
For Each varArchivo In .FoundFiles
i = i + 1
Application.StatusBar = "Procesando archivo: " & varArchivo & _
"(" & i & " de " & .FoundFiles.Count & " )"
CopyData varArchivo
Next
Else
MsgBox "Ningún archivo encontrado."
End If
Application.ScreenUpdating = True
End With
Application.StatusBar = False
End Sub
Sub CopyData(ByVal strArchivo As String)
Dim wbData As Workbook, wsData As Worksheet, wsDest As Worksheet
Dim rngFuente As Range, rngDest As Range
Set wbData = Workbooks.Open(Filename:=strArchivo)
Set wsData = wbData.Worksheets(1)
Set wsDest = ThisWorkbook.Worksheets(1)
Set rngDest = wsDest.Range("A65536").End(xlUp).Offset(1)
If rngDest.Address = "$A$2" And wsDest.[A1].Formula = "" Then
Set rngDest = rngDest.Offset(-1)
End If
Set rngFuente = wsData.Range("A1:IV3")
rngFuente.Copy rngDest
wbData.Close SaveChanges:=False
End Sub
****************************************************************************************
En la funcion CopyData es donde tengo el problema, ya que no se como hacer que me copie determinadas celdas de cada .xls, tal como esta ahora lo que hace es copiar las 3 primeras filas de cada .xls origen en el .xls destino consecutivamente. Por ejemplo necesito que copie la A1,B3, C10,F4,E5 de cada .xls, en un .xls destino de la forma A1,B1,C1,D1,E1 (en una misma fila).
Espero que alguien pueda echar un ojo al codigo y ver como lo puedo hacer, seguro que podeis ayudarme.
Feliz navidad, y gracias de ante mano.
Un saludo.
tengo un codigo en visual basic para excel que me habre todos los archivos .xls de una carpeta y me copia unas determinadas filas de cada archivo en una hoja de calculo nueva. Pero la funcion que me hace esta copia no consigo que haga lo que yo necesito, que es copiar unas determninadas celdas de cada archivo (las mismas en todos los archivos .xls) en filas de mi hoja de calculo destino, y asi poder gestionar todos los .xls desde una sola hoja de calculo, este es el codigo:
****************************************************************************************
Sub AbriryCopiar()
' La carpeta con los archivos para abrir.
Const strSendero As String = "D:UN52617"
Dim varArchivo As Variant, i%
Dim fs As FileSearch
Set fs = Application.FileSearch
' Cambie la hilera "xxx*.xls" para que sea una
' mascara que devolverá los archivos deseados.
' Si desea todos, borre la línea.
With fs
.NewSearch
.LookIn = strSendero
.SearchSubFolders = False
'.FileType = msoFileTypeExcelWorkbooks
.Filename = "*.xls"
If .Execute > 0 Then
Application.ScreenUpdating = False
For Each varArchivo In .FoundFiles
i = i + 1
Application.StatusBar = "Procesando archivo: " & varArchivo & _
"(" & i & " de " & .FoundFiles.Count & " )"
CopyData varArchivo
Next
Else
MsgBox "Ningún archivo encontrado."
End If
Application.ScreenUpdating = True
End With
Application.StatusBar = False
End Sub
Sub CopyData(ByVal strArchivo As String)
Dim wbData As Workbook, wsData As Worksheet, wsDest As Worksheet
Dim rngFuente As Range, rngDest As Range
Set wbData = Workbooks.Open(Filename:=strArchivo)
Set wsData = wbData.Worksheets(1)
Set wsDest = ThisWorkbook.Worksheets(1)
Set rngDest = wsDest.Range("A65536").End(xlUp).Offset(1)
If rngDest.Address = "$A$2" And wsDest.[A1].Formula = "" Then
Set rngDest = rngDest.Offset(-1)
End If
Set rngFuente = wsData.Range("A1:IV3")
rngFuente.Copy rngDest
wbData.Close SaveChanges:=False
End Sub
****************************************************************************************
En la funcion CopyData es donde tengo el problema, ya que no se como hacer que me copie determinadas celdas de cada .xls, tal como esta ahora lo que hace es copiar las 3 primeras filas de cada .xls origen en el .xls destino consecutivamente. Por ejemplo necesito que copie la A1,B3, C10,F4,E5 de cada .xls, en un .xls destino de la forma A1,B1,C1,D1,E1 (en una misma fila).
Espero que alguien pueda echar un ojo al codigo y ver como lo puedo hacer, seguro que podeis ayudarme.
Feliz navidad, y gracias de ante mano.
Un saludo.
Valora esta pregunta


0