none
Vba copiar linha determinando o critério e colar em outra planilha RRS feed

  • Pergunta

  • Pessoal

    Tenho o seguinte macro abaixo, porem o mesmo não continua a busca pelo critério quando ultrapassa as 32.765 linhas.

    'Contador move para a proxima linha'
    vCopiaLinha = vCopiaLinha + 1

    Favor, gostaria de saber como corrigir o macro para continuar a busca, pois a planilha de dados possui mais 215.000 linhas

    Sub binderfaixa2()

    Dim vLocalizaLinha As Integer
    Dim vCopiaLinha As Integer
    Sheets("binder faixa 2").Select
    Range("a2:m250000").ClearContents
    Sheets("Relatorio Usina L3").Select
    On Error GoTo Err_Execute

    'Inicia busca na linha 2
    vLocalizaLinha = 2

    'Start copying data to row 2 in Plan2 (row counter variable)
    'Comece a copiar dados para linha 2 em Plan2 (linha contariam a variável)
    vCopiaLinha = 2

    While Len(Range("A" & CStr(vLocalizaLinha)).Value) > 0

    'Se valor na coluna J = "binder faixa 2", copie a linha inteira a Plan2
    If Range("J" & CStr(vLocalizaLinha)).Value = Range("AA1").Value Then

    'selecionando a planilha 1 para copiar
    Rows(CStr(vLocalizaLinha) & ":" & CStr(vLocalizaLinha)).Select
    Selection.Copy

    'colando na planilha 2 na proxima linha
    Sheets("binder faixa 2").Select
    Rows(CStr(vCopiaLinha) & ":" & CStr(vCopiaLinha)).Select
    Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, _
    Transpose:=False
    Application.CutCopyMode = False
       
    'Contador move para a proxima linha
    vCopiaLinha = vCopiaLinha + 1

    'volta para Planilha1 e continua a busca
    Sheets("Relatorio Usina L3").Select

    End If

    vLocalizaLinha = vLocalizaLinha + 1

    Wend

    'reposiciona na celula (A3)
    Application.CutCopyMode = False
    Range("A2").Select

    Sheets("Menu").Select

    MsgBox "Todos os dados procurados binderfaixa2 foram copiados ."

    Exit Sub

    Err_Execute:
    MsgBox "ocorreu um erro.", vbInformation, "Saberexcel - o site das macros"
     
    End Sub

    <input id="357dc208-ac2d-44f8-bfb2-0dc2e608fa8c_attachments" type="hidden" />
    quarta-feira, 6 de março de 2013 00:37

Respostas

  • Seu código pode ser melhorado, mas para o que precisa, use o código abaixo:

    Sub binderfaixa2()
    
        Dim vLocalizaLinha As Integer
        Dim vCopiaLinha As Integer
        Sheets("binder faixa 2").Select
        Range("a2:m250000").ClearContents
        Sheets("Relatorio Usina L3").Select
        On Error GoTo Err_Execute
    
        'Start copying data to row 2 in Plan2 (row counter variable)
        'Comece a copiar dados para linha 2 em Plan2 (linha contariam a variável)
        vCopiaLinha = 2
    
        For localizalinha = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    
            'Se valor na coluna J = "binder faixa 2", copie a linha inteira a Plan2
            If Range("J" & CStr(vLocalizaLinha)).Value = Range("AA1").Value Then
    
                'selecionando a planilha 1 para copiar
                Rows(CStr(vLocalizaLinha) & ":" & CStr(vLocalizaLinha)).Select
                Selection.Copy
    
                'colando na planilha 2 na proxima linha
                Sheets("binder faixa 2").Select
                Rows(CStr(vCopiaLinha) & ":" & CStr(vCopiaLinha)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, _
                                       Operation:=xlNone, SkipBlanks:=False, _
                                       Transpose:=False
                Application.CutCopyMode = False
    
                'Contador move para a proxima linha
                vCopiaLinha = vCopiaLinha + 1
    
                'volta para Planilha1 e continua a busca
                Sheets("Relatorio Usina L3").Select
    
            End If
    
        Next vLocalizaLinha
    
        'reposiciona na celula (A3)
        Application.CutCopyMode = False
        Range("A2").Select
    
        Sheets("Menu").Select
    
        MsgBox "Todos os dados procurados binderfaixa2 foram copiados ."
    
        Exit Sub
    
    Err_Execute:
        MsgBox "ocorreu um erro.", vbInformation, "Saberexcel - o site das macros"
    
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 7 de março de 2013 00:02
    Moderador

Todas as Respostas

  • Seu código pode ser melhorado, mas para o que precisa, use o código abaixo:

    Sub binderfaixa2()
    
        Dim vLocalizaLinha As Integer
        Dim vCopiaLinha As Integer
        Sheets("binder faixa 2").Select
        Range("a2:m250000").ClearContents
        Sheets("Relatorio Usina L3").Select
        On Error GoTo Err_Execute
    
        'Start copying data to row 2 in Plan2 (row counter variable)
        'Comece a copiar dados para linha 2 em Plan2 (linha contariam a variável)
        vCopiaLinha = 2
    
        For localizalinha = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    
            'Se valor na coluna J = "binder faixa 2", copie a linha inteira a Plan2
            If Range("J" & CStr(vLocalizaLinha)).Value = Range("AA1").Value Then
    
                'selecionando a planilha 1 para copiar
                Rows(CStr(vLocalizaLinha) & ":" & CStr(vLocalizaLinha)).Select
                Selection.Copy
    
                'colando na planilha 2 na proxima linha
                Sheets("binder faixa 2").Select
                Rows(CStr(vCopiaLinha) & ":" & CStr(vCopiaLinha)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, _
                                       Operation:=xlNone, SkipBlanks:=False, _
                                       Transpose:=False
                Application.CutCopyMode = False
    
                'Contador move para a proxima linha
                vCopiaLinha = vCopiaLinha + 1
    
                'volta para Planilha1 e continua a busca
                Sheets("Relatorio Usina L3").Select
    
            End If
    
        Next vLocalizaLinha
    
        'reposiciona na celula (A3)
        Application.CutCopyMode = False
        Range("A2").Select
    
        Sheets("Menu").Select
    
        MsgBox "Todos os dados procurados binderfaixa2 foram copiados ."
    
        Exit Sub
    
    Err_Execute:
        MsgBox "ocorreu um erro.", vbInformation, "Saberexcel - o site das macros"
    
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 7 de março de 2013 00:02
    Moderador
  • Basta alterar a variavel de INTEGER para LONG

    terça-feira, 5 de dezembro de 2017 10:41