0

Olá! Eu tenho um código VBA no formato abaixo. Ele pega todas as informações da coluna B e manda para outra aba, sempre que o valor de B1 for alterado (só não cria outra, se já tiver uma igual), renomeando essa nova aba criada com o valor que estiver descrito em B1. No entanto, eu quero colocar nas abas novas que forem criadas, também a coluna A do modo como elas estiverem descritas na planilha original (que chamei de Plan3) (pode ser a coluna toda ou de A1:A11). Como poderia prosseguir?

   Dim i: i = 1
   Dim B1_val As String
   B1_val = ThisWorkbook.Worksheets("Plan3").Range("B1").Value
   myValue = ThisWorkbook.Worksheets("Plan3").Range("B" & i).Value
   Dim ws As Worksheet
   If Not (doesSheetExist(B1_val)) Then
      Set ws = ThisWorkbook.Worksheets.Add(Type:=xlWorksheet)
      With ws
        .Name = B1_val
      End With
        While myValue <> ""
          Set cellv = ThisWorkbook.Worksheets(B1_val).Range("B" & i)
          cellv.Value = myValue
          i = i + 1
          myValue = ThisWorkbook.Worksheets("Plan3").Range("B" & i).Value
        Wend
    
      
   End If
   
End Sub
Public Function doesSheetExist(strSName As String) As Boolean
    Set wb = ActiveWorkbook
    Dim obj As Object
    On Error GoTo ErrorHandler
    Set obj = wb.Sheets(strSName)
    doesSheetExist = True
    Exit Function
ErrorHandler:
    doesSheetExist = False
End Function

1 Resposta 1

0

Segue aqui a minha sugestão de como fazer isso. Já adianto que não é a maneira mais prática, porém como sua questão envolve apenas duas colunas, dá para fazer assim.

Entretanto, eu fiz de maneira que funcione mesmo se as colunas tiverem um número diferente de linhas preenchidas entre elas (ou seja, se a coluna A estiver preenchida até a linha 11, mas a coluna B até a linha 23 - e vice-versa - funciona mesmo assim).

Se em algum momento você precisar inserir mais colunas na Aba nova criada, sugiro você reestruturar o código e incluir as colunas adicionais usando Offset.

Por fim, segue aqui a minha sugestão:

Private Sub btAba_Click()

 Dim i: i = 1
   Dim A1_val As String
   Dim B1_val As String
   A1_val = ThisWorkbook.Worksheets("Plan3").Range("A1").Value
   B1_val = ThisWorkbook.Worksheets("Plan3").Range("B1").Value
   myValueA = ThisWorkbook.Worksheets("Plan3").Range("A" & i).Value
   myValue = ThisWorkbook.Worksheets("Plan3").Range("B" & i).Value
   Dim ws As Worksheet
   If Not (doesSheetExist(B1_val)) Then
      Set ws = ThisWorkbook.Worksheets.Add(Type:=xlWorksheet)
      With ws
        .Name = B1_val
      End With
       Do While myValue <> "" Or myValueA <> ""
          Set cellvA = ThisWorkbook.Worksheets(B1_val).Range("A" & i)
          Set cellv = ThisWorkbook.Worksheets(B1_val).Range("B" & i)
          cellvA.Value = myValueA
          cellv.Value = myValue
          i = i + 1
          myValueA = ThisWorkbook.Worksheets("Plan3").Range("A" & i).Value
          myValue = ThisWorkbook.Worksheets("Plan3").Range("B" & i).Value
      Loop
      
   End If
   
End Sub
Public Function doesSheetExist(strSName As String) As Boolean
    Set wb = ActiveWorkbook
    Dim obj As Object
    On Error GoTo ErrorHandler
    Set obj = wb.Sheets(strSName)
    doesSheetExist = True
    Exit Function
ErrorHandler:
    doesSheetExist = False
End Function

Qualquer problema, me avise.

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .