Macro para que me saque unos datos en otra hoja
Tengo en una carpeta muchos excels y lo que quisiera que me hiciera la macro en un nuevo excel los seria lo siguiente:
Que me coja los datos del libro 1 de la carpeta que tengo todos los excells, de la hoja DATOS EMPRESA empresa las celdas B1 y B2 y que me lo ponga en la hoja del nuevo excel en A4 - A5, y tambien que me coja de la hoja PyG las celdas B28, C28 y D28 y que me lo copia en el excel en A6-A7-A8, con el resto de los libros que la cantidades me las ponga a continuación, y si pudiera ser que me dejara un hueco ente los datos de un libro a otro.
1 Respuesta
Buenas tardes
Perdona, pero me he confundido el resultado lo quiero en A2-B2-C2-D2-E2 y el siguiente resultado en A4-B4-C4-D4-E4, el siguiente en A6-B7-C7-D7-E7 disculpa, me he confundí al redactar la pregunta
Prueba esto:
Sub Pasar_Valores()
'Por Dante Amor
'Pasar valores de varios archivos a la hoja resumen
'
Dim sh As Worksheet
Dim l2 As Workbook
Dim ruta As String
Dim arch As Variant
Dim hoja1 As String, hoja2 As String
Dim esta1 As Boolean, esta2 As Boolean
Dim i As Long
'
Application.ScreenUpdating = False
'
ruta = "C:\trabajo\"
Set sh = Sheets("Resumen")
hoja1 = "DATOS EMPRESA"
hoja2 = "PyG"
'
sh.Cells.Clear
arch = Dir(ruta & "*.xls*")
i = 2
'
Do While arch <> ""
On Error Resume Next
If IsError(GetObject(ruta & arch).Sheets(hoja1)) Then esta1 = False Else esta1 = True
If IsError(GetObject(ruta & arch).Sheets(hoja2)) Then esta2 = False Else esta2 = True
On Error GoTo 0
'
If esta1 Or esta2 Then
Set l2 = Workbooks.Open(ruta & arch)
If esta1 Then
sh.Range("A" & i).Value = l2.Sheets(hoja1).Range("B1").Value
sh.Range("B" & i).Value = l2.Sheets(hoja1).Range("B2").Value
End If
If esta2 Then
sh.Range("C" & i).Value = l2.Sheets(hoja2).Range("B28").Value
sh.Range("D" & i).Value = l2.Sheets(hoja2).Range("C28").Value
sh.Range("E" & i).Value = l2.Sheets(hoja2).Range("D28").Value
End If
l2.Close False
i = i + 2
End If
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
La macro funciona, pero cada vez que abre un libro me sale estas panatallas, seria posible que no me salieram???
Adicioné estas líneas en la macro
Application.DisplayAlerts = False Set l2 = Workbooks.Open(ruta & arch, False, True)
Te envié la macro completa en la otra pregunta. Valora esta respuesta para cerrar.
