Pegado de destino distinto al original
Tengo una macro que busca otro libro y copia el contenido especifico
Y lo pega en el libro de destino distinto al de origen
Adjunto ejemplo y macro, tal vez esta mal
La macro solicita la dirección del libro a copia luego recorre hasta la ultima columna y fila con dato desde un rango los copia y pega en otra hoja hasta hay ningún problema
Es solo el pegado el error
Libro de origen :
libro de destino :
Macro :
Sub buscar_datos()
Dim dir As String 'decalaras
MsgBox "Selecionar Excel Inventario"
dir = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*") 'selecionas el libro
Workbooks.Open Filename:=(dir)
Sheets(1).Select
ActiveSheet.Range("B1:B8", ActiveSheet.Range("B1:B8").End(xlToRight)).Select
Selection.Copy
ActiveWorkbook.Close SaveChanges:=False
Sheets(1).Select
Range("B1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
¿Por lo que veo al parecer tus numero te los cambia a Texto cierto?
Para eso utiliza esta macro te convierte lo que tengas como texto a numero nuevamente, adáptalo fila 6
Sub ConvertirTextotANumero() Dim celda As Range Application.StatusBar = "Convirtiendo celdas seleccionadas a formato de número..." r = "B4:L7" For Each celda In Range(r) 'Se evalua cada celda del rango y se hace la conversión celda.Value = CStr(celda) Next celda Application.StatusBar = False End Sub
Hola
Gracias por tu tiempo
La verdad no se como podría adaptarlo
Recién estoy entrando el vba
Me podrías ayudar
Saludos
¿Sigue tu problema o lo pudiste resolver?
2 respuestas más de otros expertos
Hola Abraham
gracias por tu tiempo al responder
la macro esta completa
al pegar la copia del origen lo pega como texto me parece y no concerva el formato original
puedo enviarte los archivos ¿? o no es necesario
saludos
No es necesario. Ya vi lo que ocurre. Si cierras el libro origen antes de pegar los datos, lo que tienes en el portapapeles se mantienen solo como texto, por eso lo pega así y pierden el formato. Si deseas mantener su formato, debe cerrar el libro origen después de pegar los datos.
Abraham Valencia
TU ayuda
No logro cerrar después de pegar
Queda pegado en el mismo libro activo
:(
Ayuda con el código
¿Cuáles son los nombres de los archivos/libros y cuáles son los nombres de las hojas?
Abraham Valencia
Hola
el Archivo donde se pegan los datos siempre mismo nombre ANÁLISIS 1.1 y la hoja1 ("BRECHA")
Archivo origen de datos varia el nombre son distintos archivos y varían los datos también
por eso debe detectar hasta el ultima columna con datos y la ultima fila siempre es la 8
pero la hoja siempre es la misma Brecha
saludos
Yo lo haría diferente, pero como para que puedas entenderlo he respetado tus códigos:
Sub buscar_datos()
Dim dir As String, NombreArchivo As String
MsgBox "Selecionar Excel Inventario"
dir = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , "Selecciona tu archivo", , False) 'selecionas el libro
Workbooks.Open Filename:=(dir)
Let NombreArchivo = Mid$(dir, InStrRev(name_f, "\") + 1)
Sheets(1).Select
ActiveSheet.Range("B1:B8", ActiveSheet.Range("B1:B8").End(xlToRight)).Copy
Workbooks("ANÁLISIS 1.1").Activate
Sheets(1).Select
Range("B1").Select
ActiveSheet.Paste
Workbooks("NombreArchivo").Close SaveChanges:=False
Application.CutCopyMode = False
End SubSalu2
Abraham Valencia
ayuda :(
¿Probaste lo que te mandé?
Abraham Valencia
Por cierto, reemplaza por ésta la línea correspondiente:
Let NombreArchivo = Mid$(dir, InStrRev(dir, "\") + 1)
Abraham Valencia
Te propongo esta macro copia de una manera más eficiente
Sub busca_datos()
nombre = ActiveWorkbook.Name
Set destino = Workbooks(nombre).Sheets(1).Range("a1").CurrentRegion
With destino
f = .Rows.Count: c = .Columns.Count
Set destino = .Cells(2, 2).Resize(f - 1, c - 1)
End With
Dim dir As String 'decalaras
MsgBox "Selecionar Excel Inventario"
dir = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*") 'selecionas el libro
Workbooks.Open Filename:=(dir)
nombre = ActiveWorkbook.Name
Set origen = Workbooks(nombre).Sheets(1).Range("a1").CurrentRegion
With origen
f = .Rows.Count: c = .Columns.Count
Set origen = .Cells(2, 2).Resize(f - 1, c - 1)
destino.Value = .Value
End With
ActiveWorkbook.Close SaveChanges:=False
End Sub