☰

Mesclar 2 colunas em folhas separadas em uma coluna

tag-icon • tag-icon microsoft-excel worksheet-function vba
Mesclar 2 colunas em folhas separadas em uma coluna

Tenho 2 listas em duas folhas separadas e estou tentando combiná-las em uma terceira folha. Essas listas são preenchidas automaticamente com base na entrada do usuário, portanto, o número de linhas na lista pode variar. Assim, uma vez que não detecta nada na primeira coluna da planilha um, ele começa a preencher a lista da planilha 3 com as colunas da planilha 2, assim

Folha 1

Make    Model     License Plate
Ford    Escape    UVC345
Honda   Civic     KD2YR9

Folha 2

Make    Model    License Plate 
Dodge   Charger  34TRLS2
VW      Passat   V70YTR

Folha 3

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

Atualizar:

O problema que estou enfrentando ao usar o VBA para copiar e colar é que ele está colando e identificando as fórmulas que são usadas para preencher automaticamente a lista inicial na planilha 1. Por estar colando as fórmulas, não está identificando corretamente onde a última célula está na planilha 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

Responder1

Você pode fazer isso com funções de planilha.

Digamos que sua primeira planilha seja Sheet1e a segunda sejaExtra1

Coloque a seguinte fórmula em sua planilha mesclada em A2 e copie e cole nas outras células:

=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)))

Como isso funciona:

  1. Verifica se a linha atual é maior que o número de linhas da primeira planilha + a segunda planilha menos um (porque ambas possuem cabeçalhos);
  2. Se a linha atual for maior, mostre vazio. Caso contrário, vai para a próxima etapa;
  3. Prepara um INDIRECT. Se a linha atual for inferior às linhas da primeira planilha, obtém o nome da primeira planilha. Caso contrário, recebe o nome da segunda planilha;
  4. Ele usa o SUBSTITUTE + ADDRESStruque para retornar a letra atual da coluna. É bom porque aí ele usa a mesma fórmula em todos os campos, e aceita mesmo quando a coluna vira AA
  5. Por fim, obtém a linha atual se a linha atual for menor que o número de itens da primeira planilha, caso contrário obtém a linha atual MENOS a contagem de linhas da primeira planilha, menos um, para retornar a linha inicial da planilha dois .

Eu sei que é um pouco complicado e difícil de ler, mas às vezes as fórmulas são melhores que o VBA.

Editar: Bem, tive uma epifania e consegui uma versão VBA funcional

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

informação relacionada