Doesn't show the value on the sheet

Question

The code have to do this: Open the external file to push the information, if the id is the same at the other sheet they copy the value of the two columns and paste on the column on the sheet "Controle Geral", if he is not empty jump 2 columns and put the value

Sub TransferirDados()
    Dim pasta As String
    Dim arquivoOrigem As String
    Dim wbOrigem As Workbook
    Dim planilhaOrigem As Worksheet
    Dim planilhaDestino As Worksheet
    Dim últimaLinhaOrigem As Long
    Dim últimaLinhaDestino As Long
    Dim linhaDestino As Long
    Dim contadorVazios As Integer
    Dim i As Long
    Dim j As Long
    Dim colunaDestino As Long
    
    pasta = ThisWorkbook.Path ' Obtém a pasta do arquivo atual
    arquivoOrigem = "the path" ' Define o caminho do arquivo de origem
    
    ' Abre o arquivo de origem
    Set wbOrigem = Workbooks.Open(Filename:=arquivoOrigem)
    
    ' Defina a planilha de origem e destino
    Set planilhaOrigem = wbOrigem.Sheets("Sheet1")
    Set planilhaDestino = ThisWorkbook.Sheets("Controle Geral 2023")
    
    ' Determine a última linha na planilha de origem e destino
    últimaLinhaOrigem = planilhaOrigem.Cells(planilhaOrigem.Rows.Count, "C").End(xlUp).Row
    últimaLinhaDestino = planilhaDestino.Cells(planilhaDestino.Rows.Count, "A").End(xlUp).Row
    
    ' Inicializa a variável de contador de linhas vazias
    contadorVazios = 0
    
    ' Percorre as linhas da planilha de origem
    For i = 2 To últimaLinhaOrigem ' Supondo que a primeira linha contenha cabeçalhos
        ' Verifica se a célula na coluna C não está vazia
        If planilhaOrigem.Cells(i, "C").Value <> "" Then
            ' Percorre as linhas da planilha de destino
            For j = 2 To últimaLinhaDestino
                ' Verifica se há igualdade entre os valores nas colunas C e A
                If planilhaOrigem.Cells(i, "C").Value = planilhaDestino.Cells(j, "A").Value Then
                    ' Verifica se há três linhas vazias consecutivas na coluna AD em diante
                    If VerificarLinhasVazias(planilhaDestino, j, 30, planilhaDestino.Columns.Count, 3) Then
                        ' Transfere os dados das colunas F, G e C
                        planilhaOrigem.Cells(i, "F").Copy planilhaDestino.Cells(j, "AC")
                        planilhaOrigem.Cells(i, "G").Copy planilhaDestino.Cells(j, "AD")
                        planilhaOrigem.Cells(i, "C").Copy planilhaDestino.Cells(j, "B")
                    ElseIf VerificarLinhasVazias(planilhaDestino, j, 29, planilhaDestino.Columns.Count, 3) Then
                        ' Transfere os dados das colunas F, G e C
                        planilhaOrigem.Cells(i, "F").Copy planilhaDestino.Cells(j, "AC")
                        planilhaOrigem.Cells(i, "G").Copy planilhaDestino.Cells(j, "AF")
                        planilhaOrigem.Cells(i, "C").Copy planilhaDestino.Cells(j, "B")
                    ElseIf VerificarLinhasVazias(planilhaDestino, j, 28, planilhaDestino.Columns.Count, 3) Then
                        ' Transfere os dados das colunas F, G e C
                        planilhaOrigem.Cells(i, "F").Copy planilhaDestino.Cells(j, "AC")
                        planilhaOrigem.Cells(i, "G").Copy planilhaDestino.Cells(j, "AG")
                        planilhaOrigem.Cells(i, "C").Copy planilhaDestino.Cells(j, "B")
                    End If
                    Exit For ' Sai do loop interno quando encontrar uma correspondência
                End If
            Next j
        End If
    Next i
    
    ' Fecha o arquivo de origem
    wbOrigem.Close SaveChanges:=False
    
    MsgBox "Dados transferidos com sucesso!", vbInformation
End Sub

Function VerificarLinhasVazias(planilha As Worksheet, linhaInicial As Long, colunaInicial As Long, colunaFinal As Long, quantidadeLinhas As Integer) As Boolean
    Dim i As Long
    Dim contadorVazios As Integer
    
    ' Inicializa a variável de contador de linhas vazias
    contadorVazios = 0
    
    ' Percorre as colunas especificadas
    For i = colunaInicial To colunaFinal
        ' Verifica se a célula está vazia
        If planilha.Cells(linhaInicial, i).Value = "" Then
            contadorVazios = contadorVazios + 1
            ' Verifica se já foram encontradas as linhas vazias necessárias
            If contadorVazios = quantidadeLinhas Then
                VerificarLinhasVazias = True
                Exit Function ' Sai da função se já foram encontradas as linhas vazias necessárias
            End If
        Else
            contadorVazios = 0 ' Reseta o contador de linhas vazias
        End If
    Next i
    
    VerificarLinhasVazias = False ' Retorna False se não foram encontradas as linhas vazias necessárias
End Function

Please provide more details on the specific issue with your code. — taller_ExcelHome, Jul 18 '23 at 02:20
Pls. provide a sample about the required result. Just now the question, the comments in the code and the code itself are three different things. — Black cat, Jul 18 '23 at 04:46

taller_ExcelHome · Answer 1 · 2023-07-18T17:11:48.830

The provided CheckEmptyRows function is checking for 3 consecutive blank COLUMNS instead of ROWS starting from column AD. The Worksheet function COUNTA can be used to check if a range is blank. Please correct me if I have misunderstood the request.

    ' Percorre as linhas da planilha de origem
    For i = 2 To últimaLinhaOrigem ' Supondo que a primeira linha contenha cabe?alhos
        ' Verifica se a célula na coluna C n?o está vazia
        If planilhaOrigem.Cells(i, "C").Value <> "" Then
            ' Percorre as linhas da planilha de destino
            For j = 2 To últimaLinhaDestino
                ' Verifica se há igualdade entre os valores nas colunas C e A
                Dim k As Integer
                If planilhaOrigem.Cells(i, "C").Value = planilhaDestino.Cells(j, "A").Value Then
                    ' Verifica se há três linhas vazias consecutivas na coluna AD em diante
                    For k = 30 To planilhaDestino.Columns.Count - 1 Step 2
                        If Application.CountA(planilhaDestino.Cells(j, k).Resize(3, 1)) = 0 Then
                            planilhaOrigem.Cells(i, "C").Copy planilhaDestino.Cells(j, "B")
                            planilhaOrigem.Cells(i, "F").Copy planilhaDestino.Cells(j, "AC")
                            planilhaOrigem.Cells(i, "G").Copy planilhaDestino.Cells(j, k)
                            Exit For
                        End If
                    Next
                    Exit For ' Sai do loop interno quando encontrar uma correspondência
                End If
            Next j
        End If
    Next i

Doesn't show the value on the sheet

1 Answers1