☰

Fusionar 2 columnas en hojas separadas en una sola columna

tag-icon • tag-icon microsoft-excel worksheet-function vba
Fusionar 2 columnas en hojas separadas en una sola columna

Tengo 2 listas en dos hojas separadas y estoy intentando combinarlas en una tercera hoja. Estas listas se completan automáticamente según la entrada del usuario, por lo que la cantidad de filas dentro de la lista puede variar. Entonces, una vez que no detecta nada en la primera columna de la hoja uno, comienza a completar la lista de la hoja 3 con las columnas de la hoja 2, así

Hoja 1

Make    Model     License Plate
Ford    Escape    UVC345
Honda   Civic     KD2YR9

Hoja 2

Make    Model    License Plate 
Dodge   Charger  34TRLS2
VW      Passat   V70YTR

Hoja 3

Make    Model    License Plate
Ford    Escape   UVC345
Honda   Civic    KD2YR9
Dodge   Charger  34TRLS2
VW      Passat   V70YTR

Actualizar:

El problema con el que me encuentro cuando uso VBA para copiar y pegar es que pega e identifica las fórmulas que se usan para completar automáticamente la lista inicial en la hoja 1. Debido a que pega las fórmulas, no identifica correctamente dónde la última celda está en la hoja 3.

Sub Copy_Alternatives()

Worksheets("CNA eTool Alternatives").Range("A:A").Copy
Worksheets("Repair Replacement Recom").Range("A:A").PasteSpecial xlPasteValues
Worksheets("CNA eTool Alternatives").Range("B:B").Copy
Worksheets("Repair Replacement Recom").Range("B:B").PasteSpecial xlPasteValues
Worksheets("CNA eTool Alternatives").Range("C:C").Copy
Worksheets("Repair Replacement Recom").Range("C:C").PasteSpecial xlPasteValues

End Sub

Sub Copy_Paste_Range()

Dim lNewRow As Long
Dim lDataRow As Long

ThisWorkbook.Activate

lNewRow = Worksheets("CNA eTool Addit. Alternatives").Cells(Worksheets("CNA eTool Addit. Alternatives").Rows.Count, "H").End(xlUp).Row

lDataRow = Worksheets("Repair Replacement Recom").Cells(Worksheets("Repair Replacement Recom").Rows.Count, 1).End(xlUp).Row
lDataRow = lDataRow + 1

Worksheets("CNA eTool Addit. Alternatives").Range("H2:J" & lNewRow).Copy
Worksheets("Repair Replacement Recom").Range("A" & lDataRow).PasteSpecial

End Sub

Respuesta1

Puedes hacerlo con funciones de hoja de trabajo.

Digamos que tu primera hoja es Sheet1y la segunda esExtra1

Coloque la siguiente fórmula en su hoja combinada en A2, luego cópiela y péguela en las otras celdas:

=IF(ROW()>COUNTA(Sheet1!A:A)+COUNTA(Extra1!A:A)-1,"",INDIRECT(IF(ROW()<=COUNTA(Sheet1!A:A),"Sheet1!","Extra1!")&SUBSTITUTE(ADDRESS(1,COLUMN(),4),1,"")&ROW()-IF(ROW()<=COUNTA(Sheet1!A:A),0,COUNTA(Sheet1!A:A)-1)))

Cómo funciona esto:

  1. Comprueba si la línea actual es mayor que el número de líneas de la primera hoja + la segunda hoja menos una (porque ambas tienen encabezados);
  2. Si la línea actual es mayor, se muestra vacía. De lo contrario, pasa al siguiente paso;
  3. Prepara un INDIRECT. Si la línea actual es inferior a las líneas de la primera hoja, obtiene el nombre de la primera hoja. De lo contrario, obtiene el nombre de la segunda hoja;
  4. Utiliza el SUBSTITUTE + ADDRESStruco para devolver la letra actual de la columna. Es bueno porque usa la misma fórmula en todos los campos y acepta incluso cuando la columna se convierte en AA.
  5. Finalmente, obtiene la línea actual si la línea actual es menor que el número de elementos en la primera hoja; de lo contrario, obtiene la línea actual MENOS el recuento de líneas de la primera hoja, menos uno, para devolver la línea inicial de la hoja dos. .

Sé que es un poco abrumador y más difícil de leer, pero a veces las fórmulas son mejores que VBA.

Editar: Bien, tuve una epifanía y obtuve una versión de VBA que funciona

Sub merge()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Set ws1 = Sheets("Sheet1") 'First sheet to get merged
Set ws2 = Sheets("Extra1") 'Second sheet to get merged
Set ws3 = Sheets("Merged") 'Name of the sheet you want results
Dim lr As Long 'To return the number of the last row
Dim arrayone As Variant
lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
arrayone = Range(ws1.Cells(2, 1), ws1.Cells(lr, 3)).Value 'From Row 2 onwards, considering it has headers
Dim arr2 As Variant
lr = ws2.Cells(Rows.Count, 1).End(xlUp).Row
arr2 = Range(ws2.Cells(2, 1), ws2.Cells(lr, 3)).Value 'From Row 2 onwards, considering it has headers
Dim arr3 As Variant
ReDim arr3(1 To UBound(arrayone, 1) + UBound(arr2, 1), 1 To 3)
For i = 1 To UBound(arr3, 1)
    For j = 1 To 3
        If i <= UBound(arrayone, 1) Then
            arr3(i, j) = arrayone(i, j)
        Else
            arr3(i, j) = arr2(i - UBound(arrayone, 1), j)
        End If
    Next j
Next i
Range(ws3.Cells(2, 1), ws3.Cells(UBound(arr3) + 1, 3)).Value = arr3
End Sub

información relacionada