Copie o intervalo de dados com base no valor da célula

Question

Eu tenho uma lista com as colunas A a C. A coluna B contém "A" "B" ou "C". Eu preciso copiar todos os dados das colunas A para C para uma nova planilha, dependendo do valor na coluna B.

Euquerocopiarparaaplanilha1quandoacolunaBé"A", para a planilha 2 quando a coluna B é "B" e para a planilha 3 quando a coluna B é "C".

Eu tentei o VBA usando For i = 1 to .End(xlUp).Offset(0) , mas o que devo fazer? O que eu tentei não estava funcionando para mim.

    

Answer 1

O código abaixo assume que a planilha contendo os dados a serem copiados tem o nome "Main". Ele também pressupõe que suas planilhas "colar" contenham cabeçalhos de colunas, para que ele comece a colar na linha 2. Se isso não for o que você deseja, remova a chamada .Offset(1, 0) da linha que está colando.

Você provavelmente desejará um melhor tratamento de erros do que a linha Debug.Print , mas deixarei isso para você.

Testado no Excel 2007 e funcionando como esperado.

Sub DoCopy()

  Const copySheetName As String = "Main"
  Dim rw As Integer
  Dim lngRowStart As Long
  Dim lngRowEnd As Long

  Dim copySheet As Excel.Worksheet: Set copySheet = ThisWorkbook.Worksheets(copySheetName)
  Dim pasteSheet As Excel.Worksheet

  lngRowStart = 1 'number of first row containing data to copy
  lngRowEnd = 17  'number of last row containing data to copy

  'the "Copy" sheet be the active sheet in order to copy/paste (avoid run-time error 1004)
  ThisWorkbook.Worksheets(copySheetName).Activate

  For rw = lngRowStart To lngRowEnd

    copySheet.Range(Cells(rw, 1), Cells(rw, 3)).Copy

    Select Case Cells(rw, 2)
      Case "a"
        Set pasteSheet = ThisWorkbook.Worksheets("Sheet1")
      Case "b"
        Set pasteSheet = ThisWorkbook.Worksheets("Sheet2")
      Case "c"
        Set pasteSheet = ThisWorkbook.Worksheets("Sheet3")
      Case Else
        Debug.Print "Invalid Value: " & Cells(rw, 2) & " (row " & rw & ")"
        GoTo SkipRow
    End Select

    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

SkipRow:
  Next rw

  Application.CutCopyMode = False
  Set copySheet = Nothing
  Set pasteSheet = Nothing
End Sub

    

Answer 2

Desculpe, mas eu só tenho tempo para testar isso e não funciona. Pendurou durante o "   Dim copySheet As Excel.Worksheet: Set copySheet = ThisWorkbook.Worksheets (copySheetName) "

meus dados originais na planilha "data", eu já atualizei o nome para ser copySheetName As String="data"

você tem alguma idéia de por que isso não funciona? Obrigado.