Copiar intervalo de dados com base no valor da célula

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

dados de amostra

Quero copiar para a planilha 1 quando a coluna B é "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.

microsoft-excel

— Keith So
fonte

O código abaixo assume que a planilha que contém os dados a serem copiados é denominada "Principal". Ele também pressupõe que suas folhas de "colagem" contêm cabeçalhos de coluna e, portanto, começará a colar na linha 2. Se não for o que você deseja, remova a .Offset(1, 0)chamada da linha que está fazendo a colagem.

Você provavelmente desejará um tratamento de erro melhor do que a Debug.Printlinha única , mas deixarei isso para você.

Testado no Excel 2007 e funcionando conforme o 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

— MJH
fonte

Thx vou tentar, realmente aprecio a sua ajuda

— Keith Então,

Só mais uma pergunta, pode "a" como os critieria alterações ao valor da célula

— Keith Então,

Desculpe, mas não entendi sua pergunta. Você poderia reformular?

— MJH 28/08

Desculpe, eu vi que havia fórmulas usando a função CASE e gostaria de saber se é possível alterar o caso "a", caso "b" para um valor da célula, digamos a célula "A1" e, portanto, posso digitar os critérios na célula A1 para obter um valor de célula. resultado

— Keith So

Você pode consultar o valor de uma célula específica usando a função 'Células'. Mas você deseja argumentos diferentes para cada 'caso'.

— MJH 29/08

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

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

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

— Keith So
fonte