Ver Mensaje Individual
  #1 (permalink)  
Antiguo 23/08/2007, 16:17
jgallet
 
Fecha de Ingreso: agosto-2007
Mensajes: 1
Antigüedad: 16 años, 8 meses
Puntos: 0
Problemas con Macro

Estoy corriendo el macro de abajo para copiar informacion de una hoja de excel cerrada a otra principal que estara abierta y tengo los siguientes problemas:


- son alrededor de 100 hojas con informacion en el siguiente formato:

A B
nombre Pedro Perez
vendedor Alberto
precio 10000
tipo Nuevo
.
.
.
etc

En la hoja prioncipal voy a necesitar correr el macro y copiar la informacion de las hojas detalladas pero de la columna B nada mas. por lo tanto la hoja detallada se auto-alimentaria de la siguiente forma:

A B C D.......................ZZ
Nombre Vendedor Precio Tipo.....................etc
Pedro Perez Alberto 10000 Nuevo.................etc
. .
. .
. .

etc etc

No se como hacer esto por medio de un macro que automaticamente importe la informacion de las 100 hojas detalladas y cada una de estas pudiera tener multiples tabs dentro en una sola hoja de excel en el formato descrito arriba, cualquier ayuda sera bien agradecida.

Saludos,

Sub TestReadDataFromWorkbook()
' fills data from a closed workbook in at the active cell
Dim tArray As Variant, r As Long, c As Long
tArray = ReadDataFromWorkbook("C:\data\test.xls", "A1:D21")
' without transposing
For c = LBound(tArray, 2) To UBound(tArray, 2)
For r = LBound(tArray, 1) To UBound(tArray, 1)
ActiveCell.Offset(c, r).Formula = tArray(r, c)

Next r
Next c
' with transposing
' tArray = Application.WorksheetFunction.Transpose(tArray)
' For r = LBound(tArray, 1) To UBound(tArray, 1)
' For c = LBound(tArray, 2) To UBound(tArray, 2)
' ActiveCell.Offset(r - 1, c - 1).Formula = tArray(r, c)
' Next c
' Next r
End Sub

Private Function ReadDataFromWorkbook(SourceFile As String, SourceRange As String) As Variant
' requires a reference to the Microsoft ActiveX Data Objects library
' if SourceRange is a range reference:
' this function can only return data from the first worksheet in SourceFile
' if SourceRange is a defined name reference:
' this function can return data from any worksheet in SourceFile
' SourceRange must include the range headers
' examples:
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.x ls", "A1:A21")
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.x ls", "A1:B21")
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.x ls", "DefinedRangeName")
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & SourceFile
Set dbConnection = New ADODB.Connection
On Error GoTo InvalidInput
dbConnection.Open dbConnectionString ' open the database connection
Set rs = dbConnection.Execute("[" & SourceRange & "]")
On Error GoTo 0
ReadDataFromWorkbook = rs.GetRows ' returns a two dim array with all records in rs
rs.Close
dbConnection.Close ' close the database connection
Set rs = Nothing
Set dbConnection = Nothing
On Error GoTo 0
Exit Function
InvalidInput:
MsgBox "The source file or source range is invalid!", vbExclamation, "Get data from closed workbook"
Set rs = Nothing
Set dbConnection = Nothing
End Function