Visual Basic para Aplicaciones - Copiar celdas de entre dos .xls

Life is soft - evento anual de software empresarial
   
Vista:

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.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de JuanC

RE:Copiar celdas de entre dos .xls

Publicado por JuanC (431 intervenciones) el 26/12/2008 11:57:58
no me puse a probar el código, pero viendo 'por encima' creo que tenés que
usar Union para definir el rango origen
un ejemplo:

Option Explicit

Sub test()
Dim r As Range, v() As Variant
Dim c As Range, i&
Set r = Union([a1], [a6], [b3]) '//Celdas a copiar
For Each c In r '//Bucle para tomar los valores de cada celda
ReDim Preserve v(i) As Variant
v(i) = c.Value
i = i + 1
Next
[c1:e1] = v() '//Copia en fila
If IsArray(v) Then Erase v
Set r = Nothing
Set c = Nothing
End Sub

cualquier problema vuelves a preguntar o me envías un mail...

Saludos desde Baires, JuanC
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar