Copying data into already existing sheets and running formulas

[noellebert]

Hi I’m VERY new to VBA, but I’ve been working more and more with Excel. Below I give a background of my project and the last paragraph contains my questions.

There are 3 sheets. One is a sheet called ‘LLP Sheet’ where each column is designated to a different vehicle serial number. Going down that column is data pertaining to that vehicle’s parts. Sometimes there are 5 columns on this sheet meaning there are 5 vehicles with different data or there’s 1 column meaning there’s only 1 vehicle with data. This is the only sheet the user should be changing.

The second sheet is called ‘MasterModel’ the master tells you information for each part’s current list price for the parts listed in the ‘LLP Sheet’ sheet which feeds into the third sheet’s formulas.

The third sheet ‘Current’ calls a column in the ‘LLP Sheet’ sheet and feeds that vehicle’s information through many formulas.

I’m trying to automate this process more with VBA so other users you can use it without having to add/copy the ‘current’ sheet each time the user wants to add another vehicle then change those cells to match the column in the ‘LLP Sheet’.

So far, I’ve only been able to create a new sheet(s) for each column or vehicle automatically and name that sheet the vehicle’s serial number. If there are 5 vehicles/columns it creates 5 more sheets and so on and actually copies the column info into that sheet. How do I copy the ‘Current’ sheet into each of these new sheets and feed each vehicle’s data in the ‘LLP Sheet’ sheet through it via VBA?

I need any help I can get! Thank you!

Module 1: (copies the column from 'LLP Sheet' and puts it in new sheet)

Sub t3()
Dim lc As Long, sh As Worksheet, newSh
Set sh = ActiveSheet
With sh
lc = .Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
For i = 3 To lc
If Application.CountA(.Columns(i)) > 0 Then
Set newSh = Sheets.Add
Intersect(.UsedRange, .Columns(i)).Copy newSh.Range("A1")
End If
Next
End With
ThisWorkbook.Save
End Sub

Module 2: (names the sheet as the vehicle serial number which is at the top of each column)

Sub RenameSheet()
Dim xWs As Worksheet
Dim xRngAddress As String
Dim xName As String
Dim xSSh As Worksheet
Dim xInt As Integer
xRngAddress = Application.ActiveCell.Address
On Error Resume Next
Application.ScreenUpdating = False
For Each xWs In Application.ActiveWorkbook.Sheets
xName = xWs.Range(xRngAddress).Value
If xName <> "" Then
xInt = 0
Set xSSh = Nothing
Set xSSh = Worksheets(xName)
While Not (xSSh Is Nothing)
Set xSSh = Nothing
Set xSSh = Worksheets(xName & "(" & xInt & ")")
xInt = xInt + 1
Wend
If xInt = 0 Then
xWs.Name = xName
Else
If xWs.Name <> xName Then
xWs.Name = xName & "(" & xInt & ")"
End If
End If
End If
Next
Application.ScreenUpdating = True
End Sub

Module 4: (I’m trying to copy ‘current’ into each sheet already created by telling it how many, but it creates new sheets and doesn’t put it in the sheets already created for each column/vehicle)

Public Sub DuplicateSheetMultipleTimes()
Dim n As Integer
On Error Resume Next
n = InputBox("How many copies of the active sheet do you want to make?")

If n >= 1 Then
For numtimes = 1 To n
ActiveSheet.Copy After:=ActiveWorkbook.Sheets(Worksheets.Count)
Next
End If
End Sub