Como copiar toda la columna en Excel?
Tengo la siguiente macro
Sub search_COLUMNAS()
Application.ScreenUpdating = False
DisplayAlerts = False
Dim fil, uf As Integer
Dim path As Variant
Dim mybook As String
uf = Sheets("Libros").Range("A" & Rows.Count).End(xlUp).Row
fila = uf + 1
'Encuentra el nombre del archivo
path = Application.GetOpenFilename
FullName = Split(path, Application.PathSeparator)
mybook = FullName(UBound(FullName))
Workbooks.Open Filename:=path, UpdateLinks:=0
a = Sheets("Hoja1").Range("E23")
b = Sheets("Hoja1").Range("A23")
c = Sheets("Hoja1").Range("F23")
d = Sheets("Hoja1").Range("G23")
e = Sheets("Hoja1").Range("I23")
f = Sheets("Hoja1").Range("L23")
g = Sheets("Hoja1").Range("M23")
h = Sheets("Hoja1").Range("N23")
Workbooks(mybook).Close True
Sheets("Libros").Cells(fila, 1) = a
Sheets("Libros").Cells(fila, 2) = b
Sheets("Libros").Cells(fila, 3) = c
Sheets("Libros").Cells(fila, 4) = d
Sheets("Libros").Cells(fila, 5) = e
Sheets("Libros").Cells(fila, 6) = f
Sheets("Libros").Cells(fila, 7) = g
Sheets("Libros").Cells(fila, 8) = h
Cells(fila).RowHeight = 30
DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
No se como copiar toda la información de las columnas que extraigo del libro que selecciono
aquí están los ejemplos : https://github.com/angtor/Copiar
1 Respuesta
Te dejo la macro ajustada.
Al abrir el libro, éste queda como libro activo y debes ir pegando cada rango o col en su destino. Para ello guardé en una variable los nombres de libro y hoja para que sea más sencillo de escribir el código.
Sub search_COLUMNAS()
'ajustada x Elsamatilde
Application.ScreenUpdating = False
DisplayAlerts = False
Dim fil, uf As Integer
Dim path As Variant
Dim mybook As String
uf = Sheets("Libros").Range("A" & Rows.Count).End(xlUp).Row
fila = uf + 1
'EM: se guarda el nombre de libro y hoja donde se pegará la info
libro = ActiveWorkbook.Name
hoja = "Libros"
'Encuentra el nombre del archivo
path = Application.GetOpenFilename
FullName = Split(path, Application.PathSeparator)
mybook = FullName(UBound(FullName))
Workbooks.Open Filename:=path, UpdateLinks:=0
'EM: se guarda el fin del rango
finfila = Range("A" & Rows.Count).End(xlUp).Row
'EM: se copia x col
With Sheets("Hoja1")
.Range("E23:E" & finfila).Copy Destination:=Workbooks(libro).Sheets(hoja).Cells(fila, 1)
.Range("A23:A" & finfila).Copy Destination:=Workbooks(libro).Sheets(hoja).Cells(fila, 2)
.Range("G23:F" & finfila).Copy Destination:=Workbooks(libro).Sheets(hoja).Cells(fila, 3)
'completar el resto de las columnas
End With
Workbooks(mybook).Close True
Cells(fila).RowHeight = 30
DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sdos y no olvides valorar esta respuesta.
