Compare duas colunas em pastas de trabalho diferentes

0

Gostaria de receber ajuda sobre um problema ao tentar criar uma macro vba. Eu tenho duas pastas de trabalho e quero comparar coluna "N" na pasta de trabalho 1 a coluna "F" na pasta de trabalho 2. Em seguida, se houver uma correspondência mover para a próxima célula para baixo se não foram encontradas correspondências Eu quero copiar a próxima célula após coluna "F" na pasta de trabalho 2. A pasta de trabalho 2 não terá o mesmo nome todas as manhãs, mas o nome da pasta de trabalho sempre começa com "Cópia de", portanto criei o código abaixo para selecioná-lo usando nome parcial.

For Each ws In ActiveWorkbook.Worksheets
    If ws.Name Like "Copy of*" Then
        ws.Select
        Exit For
    End If
Next ws

Mesmo que eu possa ser apontado na direção certa, isso seria ótimo.

    
por Eric 29.09.2017 / 19:22

1 resposta

0

Esta explicação não é muito clara

...if there's a match move to the next cell down if no matches were found I want to copy the next cell after column "F" in workbook 2...

mas tente algo assim e modifique-o de acordo

Option Explicit

Public Sub CompareWorkBooks()
    Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = GetWSCopy("Copy of*")

    If Not ws2 Is Nothing Then

        Dim r As Long, cel As Range, found As Variant, ws2lr As Long

        optimizeXL True
        For r = ws1.UsedRange.Rows.Count To 1 Step -1
            Set cel = ws1.Cells(r, ws1.Columns("N").Column)
            If Len(cel.Value2) > 0 Then
                found = Application.Match(cel.Value2, ws2.UsedRange.Columns("F"), 0)

                If Not IsError(found) Then  'a match was found so move next cell down
                    cel.Offset(1).EntireRow.Insert xlDown
                Else    'match not found so copy row from ws1 to first empty row of ws2
                    ws2lr = ws2.UsedRange.Rows.Count + 1
                    ws1.UsedRange.Rows(cel.Row).EntireRow.Copy ws2.Cells(ws2lr, 1)
                End If
            End If
        Next
        optimizeXL False
    End If
End Sub
Private Function GetWSCopy(ByVal wsName As String) As Worksheet
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name Like wsName Then
            Set GetWSCopy = ws
            Exit Function
        End If
    Next
End Function

Public Sub optimizeXL(Optional ByVal settingsOff As Boolean = True)
    With Application
        .ScreenUpdating = Not settingsOff
        .Calculation = IIf(settingsOff, xlCalculationManual, xlCalculationAutomatic)
        .EnableEvents = Not settingsOff
    End With
End Sub

Além disso, você está se referindo a 2 pastas de trabalho (arquivos),
mas seu código se refere a planilhas (guias dentro da mesma pasta de trabalho)

    
por 01.10.2017 / 21:26