move data from one spreadsheet to another and repeat

[April]

I have data in one tab (Status Log Data) and want to move a row of data into
a formatted template (shell). I then want to copy the shell tab, rename the
tab and move to the next row (on the Status Log Data) and repeat.

The code below works except that it does not move to the next row and
repeat. It repeats using the same row of data from Status Log Data which
causes an error since you can not have the tab name two times. I would
appreciate any help.

Public Sub ProcStatusLogData()


Dim RowCount As Integer

Application.ScreenUpdating = False

Sheets("Shell").Select
Range("b2:b4").Select
Selection.ClearContents
Range("a6:e6").Select
Selection.ClearContents
Range("a9:i14").Select
Selection.ClearContents


For i = 1 To Rows.Count

Sheets("Status Log Data").Select


Worksheets("Shell").Cells(3, 2).Value = Worksheets("Status Log
Data").Cells(2, 1).Value
Worksheets("Shell").Cells(2, 2).Value = Worksheets("Status Log
Data").Cells(2, 2).Value
Worksheets("Shell").Cells(6, 4).Value = Worksheets("Status Log
Data").Cells(2, 3).Value
Worksheets("Shell").Cells(6, 1).Value = Worksheets("Status Log
Data").Cells(2, 4).Value
Worksheets("Shell").Cells(9, 1).Value = Worksheets("Status Log
Data").Cells(2, 5).Value
Worksheets("Shell").Cells(9, 2).Value = Worksheets("Status Log
Data").Cells(2, 6).Value
Worksheets("Shell").Cells(9, 7).Value = Worksheets("Status Log
Data").Cells(2, 7).Value
Worksheets("Shell").Cells(9, 7).Value = Worksheets("Status Log
Data").Cells(2, 8).Value
Worksheets("Shell").Cells(9, 8).Value = Worksheets("Status Log
Data").Cells(2, 9).Value
Worksheets("Shell").Cells(4, 2).Value = Worksheets("Status Log
Data").Cells(2, 10).Value
Worksheets("Shell").Cells(6, 3).Value = Worksheets("Status Log
Data").Cells(2, 11).Value
Worksheets("Shell").Cells(6, 5).Value = Worksheets("Status Log
Data").Cells(2, 12).Value
Worksheets("Shell").Cells(9, 3).Value = Worksheets("Status Log
Data").Cells(2, 13).Value



Sheets("Shell").Select
Sheets("Shell").Copy After:=Sheets(4)
Sheets("Shell (2)").Select
ActiveSheet.Name = Worksheets("Shell").Cells(2, 2).Value
Range("D37").Select
ActiveWindow.SmallScroll Down:=-18
Range("A1:I1").Select



RowCount = RowCount + 1
Next i





End Sub

 

[tompl]

This is probably not a good solution because it relies on certain assumptions
and has no error routine. But, it might work and it was a fun puzzle. Try
it & see what you think. Note that you set the value of cell G9 twice
(doesn’t make sense).

Public Sub ProcStatusLogData()

Dim wksLog As Worksheet
Dim wksShell As Worksheet
Dim lngRow As Long

Application.ScreenUpdating = False

Set wksLog = ThisWorkbook.Worksheets("Status Log Data")
Set wksShell = ThisWorkbook.Worksheets("Shell")

wksShell.Range("b2:b4").ClearContents
wksShell.Range("a6:e6").ClearContents
wksShell.Range("a9:i14").ClearContents

For lngRow = 2 To wksLog.UsedRange.Rows.Count
wksShell.Range("B3").Value = wksLog.Range("A" & lngRow).Value
wksShell.Range("B2").Value = wksLog.Range("B" & lngRow).Value
wksShell.Range("D6").Value = wksLog.Range("C" & lngRow).Value
wksShell.Range("A6").Value = wksLog.Range("D" & lngRow).Value
wksShell.Range("A9").Value = wksLog.Range("E" & lngRow).Value
wksShell.Range("B9").Value = wksLog.Range("F" & lngRow).Value
wksShell.Range("G9").Value = wksLog.Range("G" & lngRow).Value
wksShell.Range("G9").Value = wksLog.Range("H" & lngRow).Value
wksShell.Range("H9").Value = wksLog.Range("I" & lngRow).Value
wksShell.Range("B4").Value = wksLog.Range("J" & lngRow).Value
wksShell.Range("C6").Value = wksLog.Range("K" & lngRow).Value
wksShell.Range("E6").Value = wksLog.Range("L" & lngRow).Value
wksShell.Range("E9").Value = wksLog.Range("M" & lngRow).Value
wksShell.Copy After:=Sheets("Shell")
Sheets("Shell (2)").Name = Sheets("Shell (2)").Range("B2").Value
Next lngRow

Application.ScreenUpdating = True

End Sub