Macro/VBA to create new worksheets from master

[jkbrannan]

Hello,

I'm trying to write a macro to automatically create a new worksheet every time a new row of data is added to my master tab. My master tab has 17 columns of data (name, date, division, claim #, location, etc.) I would like this information to populate to a new worksheet with all of the headers in the first Column A, Rows 1-17 and all of the data in Column B, Rows 1-17. Each time someone enters a new row of information on the master tab, I'd like a way to run the macro and create another new worksheet. Is there a way to make this happen? I've written a macro to create the new worksheet but it only works once, I cannot get it to work with additional rows of information. Thank you for the help!

 

[NdNoviceHlp]

U can trial this code. U need to add the row first then run this code. HTH. Dave

Sub test()
Dim Lastrow As Integer, ws As Worksheet, ShtName As String
'copies range A1:Q & lastrow from Master sheet to new sheet name Row(n) ie. Row 17
'***add row then
With Sheets("Master")
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
ShtName = "Row " & CStr(Lastrow)
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = ShtName
End With
Sheets("Master").Range(Sheets("Master").Cells(1, "A"), Sheets("Master").Cells(Lastrow, 17)).Copy _
Destination:=ThisWorkbook.Sheets(ShtName).Range("A1")
Application.CutCopyMode = False
End Sub

ps Welcome to the Board!

 

[jkbrannan]

Thank you! This is close. But when I add a second, third, etc. row of data and run the code, it copies all of the rows' info to a new tab. I need only the second row of info on the second tab, only the third row on the third tab, etc. Does that make sense? I appreciate the help!

U can trial this code. U need to add the row first then run this code. HTH. Dave

Sub test()
Dim Lastrow As Integer, ws As Worksheet, ShtName As String
'copies range A1:Q & lastrow from Master sheet to new sheet name Row(n) ie. Row 17
'***add row then
With Sheets("Master")
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
ShtName = "Row " & CStr(Lastrow)
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = ShtName
End With
Sheets("Master").Range(Sheets("Master").Cells(1, "A"), Sheets("Master").Cells(Lastrow, 17)).Copy _
Destination:=ThisWorkbook.Sheets(ShtName).Range("A1")
Application.CutCopyMode = False
End Sub

ps Welcome to the Board!

 

[NdNoviceHlp]

That's actually what it was supposed to do. Success but failure. Anyways, so where do you want to put this row in every new tab? How are U adding new rows? Dave

 

[jkbrannan]

Ideally, I want the info from each row to be reformatted in the new tab. So in the master tab, each of these categories in a column. But in the new tab, I want the categories to be in rows, column A with the answers in column B, like below. People are just keying in the information in the master tab, the rows already exist. So I would put in a command button to run the macro after someone keys in new info. Thanks!

Status: O
Claim #: 5555-5555
Date: 1/1/18
Division: ABC123
Employee: J. Doe
Injury/Illness: sprained lower back
300 Log: Y
Lost Days: 0
Restricted Days: 0
Injury Type: Pulls, Strains, Sprains
Location (1): Electrical Room
Location (2): Anytown, USA
Supervisor: J. Smith
Severity: Medical Treatment

That's actually what it was supposed to do. Success but failure. Anyways, so where do you want to put this row in every new tab? How are U adding new rows? Dave

 

[NdNoviceHlp]

I think there are only 14 things listed above... I thought there was 17. U can change the 17 in the code to whatever. It will take the header and the lastrow from master sheet, make a new sheet named by the row number and transpose the data to A1:B17 of the new sheet. I really don't like generating new sheets and putting only a small amount of data in them. Your file size will keep getting unnecessarily large and code execution will probably slow and/or crash. Anyways, this seems to do what U want. Dave

Option Explicit
Sub test()
Dim Lastrow As Integer, ws As Worksheet, Sht As Worksheet, ShtName As String, Cnt As Integer
'copies range A1:Q1 and A(N):Q(N) from Master sheet to new sheet name ie.Row(n)at A1:B17
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sheets("Master")
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
ShtName = "Row " & CStr(Lastrow)
For Each Sht In Worksheets
If ShtName = Sht.Name Then
Sheets(ShtName).Delete
Exit For
End If
Next Sht
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = ShtName
End With
For Cnt = 1 To 17
ThisWorkbook.Sheets(ShtName).Cells(Cnt, 1) = Sheets("Master").Cells(1, Cnt)
ThisWorkbook.Sheets(ShtName).Cells(Cnt, 2) = Sheets("Master").Cells(Lastrow, Cnt)
Next Cnt
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("Master").Select
End Sub

 

[Fluff]

Another option

Sub CopyRow()

   Dim UsdRws As Long
   Dim SrcWs As Worksheet
   
   With Sheets("[COLOR=#ff0000]Info[/COLOR]")
      UsdRws = .Range("A" & Rows.Count).End(xlUp).Row
      Sheets.Add(, Sheets(Sheets.Count)).Name = "Row " & UsdRws
      .Range("A1:B17").Copy Range("A1")
      .Rows(UsdRws).Copy Range("A18")
   End With
   
End Sub

Change sheet name in red to suit

 

[jkbrannan]

This has been a huge help! Thanks so much!

I think there are only 14 things listed above... I thought there was 17. U can change the 17 in the code to whatever. It will take the header and the lastrow from master sheet, make a new sheet named by the row number and transpose the data to A1:B17 of the new sheet. I really don't like generating new sheets and putting only a small amount of data in them. Your file size will keep getting unnecessarily large and code execution will probably slow and/or crash. Anyways, this seems to do what U want. Dave

Option Explicit
Sub test()
Dim Lastrow As Integer, ws As Worksheet, Sht As Worksheet, ShtName As String, Cnt As Integer
'copies range A1:Q1 and A(N):Q(N) from Master sheet to new sheet name ie.Row(n)at A1:B17
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sheets("Master")
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
ShtName = "Row " & CStr(Lastrow)
For Each Sht In Worksheets
If ShtName = Sht.Name Then
Sheets(ShtName).Delete
Exit For
End If
Next Sht
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = ShtName
End With
For Cnt = 1 To 17
ThisWorkbook.Sheets(ShtName).Cells(Cnt, 1) = Sheets("Master").Cells(1, Cnt)
ThisWorkbook.Sheets(ShtName).Cells(Cnt, 2) = Sheets("Master").Cells(Lastrow, Cnt)
Next Cnt
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("Master").Select
End Sub

 

[NdNoviceHlp]

You are Welcome! Thanks for posting your outcome. Dave