Propogate information based on cell contents

[Guest]

Hello

I have a worksheet named "List" that contains data (text and numbers) in
column A. I'd like a macro to create a new tab with the name equivalent to
the value of cell B6 on the worksheet "List" and based on a worksheet called
"Template". The data in column A of "List" needs to be added to the new
worksheet, transposing the value of cell A1 on List to cell B3 on the new
worksheet and then continued across row 3. So A1=B3, A2=C3, A3=D3 etc.

Thanks for the help!

 

[Guest]

Go to the LIST tab and right click to VIEW CODE.

Paste this code and let me know if it's what you need.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim aWS As Worksheet
Dim myWS As Worksheet

Set aWS = Target.Parent
If Not Intersect(Target, aWS.Range("B6")) Is Nothing Then
Set myWS = Nothing
On Error Resume Next
Set myWS = Worksheets(Range("B6").Value)
On Error GoTo 0
If myWS Is Nothing Then
Set myWS = Worksheets.Add
myWS.Name = Range("B6").Value
End If
lrow = aWS.Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print lrow
For i = 1 To lrow
myWS.Cells(2, 2 + i).Value = aWS.Cells(i, 1).Value
Next i

End If

End Sub

 

[Guest]

Can this be incorporated into a button?

Go to the LIST tab and right click to VIEW CODE.

Paste this code and let me know if it's what you need.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim aWS As Worksheet
Dim myWS As Worksheet

Set aWS = Target.Parent
If Not Intersect(Target, aWS.Range("B6")) Is Nothing Then
Set myWS = Nothing
On Error Resume Next
Set myWS = Worksheets(Range("B6").Value)
On Error GoTo 0
If myWS Is Nothing Then
Set myWS = Worksheets.Add
myWS.Name = Range("B6").Value
End If
lrow = aWS.Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print lrow
For i = 1 To lrow
myWS.Cells(2, 2 + i).Value = aWS.Cells(i, 1).Value
Next i

End If

End Sub

 

[Guest]

I'm sorry, I should have told you that it executes when B6 is changed.

 

[Guest]

It's likely that B6 won't change. If the new tab could be created when a
button is clicked (crated from the control toolbar) that would be perfect!!

Thanks

 

[Guest]

Use this for the control bar code.

Sub Test()

Dim aWS As Worksheet
Dim myWS As Worksheet

Set aWS = ActiveSheet
If Not IsEmpty(aWS.Range("B6")) Then
Set myWS = Nothing
On Error Resume Next
Set myWS = Worksheets(Range("B6").Value)
On Error GoTo 0
If myWS Is Nothing Then
Set myWS = Worksheets.Add
myWS.Name = aWS.Range("B6").Value
End If
lrow = aWS.Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print lrow
For i = 1 To lrow
myWS.Cells(2, 2 + i).Value = aWS.Cells(i, 1).Value
Next i

End If