VBA - Copy and paste column to the new tab with the given code

Question

Hello! I have a VBA code in the format below. It takes all the information from column B and sends it to another tab, whenever the value of B1 is changed (only does not create another, if you already have one), renaming this new tab created with the value described in B1. However, I want to put in the new tabs that are created, also the column A as they are described in the original spreadsheet (which I called Plan3) (can be the whole column or A1:A11). How could I proceed?

   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

Answer 1

Here’s my suggestion on how to do that. Already I say that is not the most practical way, but as your question involves only two columns, it is possible to do so.

However, I did it in a way that works even if the columns have a different number of rows filled in between them (i.e., if column A is filled up to row 11, but column B up to row 23 - and vice versa - works anyway).

If at some point you need to insert more columns in the new created tab, I suggest you restructure the code and include the additional columns using Offset.

Finally, follow my suggestion:

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

Any problems, let me know.