Sub copiaColumnas()
'@dj.vivanco
Dim dict As Object, hjNueva As Worksheet, hjBD As Worksheet
Dim celda As Range, uf As Long
Set dict = CreateObject("Scripting.Dictionary") Set hjNueva = Sheets("Nueva") Set hjBD = Sheets("BD")
'AGREGAR titulos DE HOJA VIEJA BD A DICCIONARIO
For Each celda In hjBD.Range("A1:BB1")
titulo = UCase(celda.Value)
If titulo <> vbNullString Then
If Not dict.exists(titulo) Then
dict.Add titulo, celda.Column
Else: 'titulo duplicado
Debug.Print celda.Column, dict(titulo)
End If
End If
Next celda
filaMaxima = 100000 ' cien mil datos como maximo por columna
'FOR EACH HOJA NUEVA. Recorre en dict buscando valores
For Each celda In hjNueva.Range("A1:BB1") buscar = UCase(celda.Value)
If buscar <> vbNullString Then 'si hay datos continua
If dict.exists(buscar) Then
colNueva = celda.Column
colBD = dict(buscar)
filaFinal = hjBD.Cells(filaMaxima, colBD).End(xlUp).Row
filaInicio = 2 'en ambas hojas los datos comienzan en la fila 2 hacia abajo
rgNuevaInicio = Cells(filaInicio, colNueva).Address
rgNuevaFinal = Cells(filaFinal, colNueva).Address
rgBDInicio = Cells(filaInicio, colBD).Address
rgBDFinal = Cells(filaFinal, colBD).Address
'copio datos de columnas desde hoja "BD" hacia hoja "Nueva"
hjNueva.Range(rgNuevaInicio, rgNuevaFinal).Value = _
hjBD.Range(rgBDInicio, rgBDFinal).Value
'marcar con color el titulo de la columna copiada de hoja BD
hjBD.Cells(1, colBD).Interior.Color = vbGreen
'marcar con color el titulo de columna copiada de hoja Nueva
hjNueva.Cells(1, colNueva).Interior.Color = vbGreen
End If
End If
Next celda
End Sub
