Copiar varias columnas de una hoja a otra hoja
Experto:
Tengo una consulta necesito un macro que me selecciones varias columnas de una hoja (hoja1) y las copie a otra hoja (hoja2), pero las columnas que copiara son las que tienen como titulo en el encabezado o en su primera cela la palabra "KILOWAT". El rango de las columnas va desde la columna A hasta la columna Z.
* Al momento de copiarlas las tiene que hacer de manera seguida sin dejar columnas en blanco en hoja2
Infinitas gracias por su ayuda...
Tengo una consulta necesito un macro que me selecciones varias columnas de una hoja (hoja1) y las copie a otra hoja (hoja2), pero las columnas que copiara son las que tienen como titulo en el encabezado o en su primera cela la palabra "KILOWAT". El rango de las columnas va desde la columna A hasta la columna Z.
* Al momento de copiarlas las tiene que hacer de manera seguida sin dejar columnas en blanco en hoja2
Infinitas gracias por su ayuda...
1 respuesta
Respuesta de Cadipas spain
1
Yo he probado con esta turina y más o menos me funciona, sólo tiene un inconveniente, y es que si en la primera celda a1 esta la palabra KILOWAT, esta columna te la copia en ultima posición, analiza y si es un inconveniente, lo reviso y estudio la posibilidad de ponerla la 1ª, pero eso tendrá un trabajo extra, que no se si tiene su importancia...
Te adjunto la macro
With Range("a1:z1")
Set c = .Find("KILOWAT", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Sheets(1). Activate
Columns(c.Column).Select
Selection. Copy
Sheets(2). Activate
Copiarpegar
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub
Sub copiarpegar()
x = 1
Do While Sheets(2).Cells(1, x) <> ""
x = x + 1
Loop
Cells(1, x).Select
ActiveSheet.Paste
End Sub
Suerte
Te adjunto la macro
With Range("a1:z1")
Set c = .Find("KILOWAT", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Sheets(1). Activate
Columns(c.Column).Select
Selection. Copy
Sheets(2). Activate
Copiarpegar
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub
Sub copiarpegar()
x = 1
Do While Sheets(2).Cells(1, x) <> ""
x = x + 1
Loop
Cells(1, x).Select
ActiveSheet.Paste
End Sub
Suerte
