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

0

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.

Keith So
fonte

Respostas:

0

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
0

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