Excel Macro Held

[Closed]
Report
-
 Kyle L -
Hello,

If I could get some help with this macro it would be greatly appreciated. I've been working on this project for work for a while. As you can see in my code what i'm trying to do is to work down column "A" checking to see if there is a value in every fourth cell. If there is a value in in each cell then it will copy and paste some coresponding cells in column "B". The problem I am having is that my code will only go through once and then it ends as if there were no more values entered, although there are more entered.

Sub PrintScorecardsClick()

Dim LastLine As Integer, i As Integer
Dim fCell As Range
Dim bCell As Range
Dim hCell As Range


Sheets("Scorecard").Activate

Set fCell = Range("L10:L13")
Set bCell = Range("L27:L30")
Set hCell = Range("L19")


Sheets("List").Activate
LastLine = Cells(Columns("A").Rows.Count, 1).End(xlUp).Row

For i = 1 To LastLine
If Not Range("A" & i).Value = Empty Then

Worksheets("List").Range("B" & i).Copy
ActiveSheet.Paste Destination:=Worksheets("Scorecard").Range("L10")
Worksheets("List").Range("B" & i + 1).Copy
ActiveSheet.Paste Destination:=Worksheets("Scorecard").Range("L11")
Worksheets("List").Range("B" & i + 2).Copy
ActiveSheet.Paste Destination:=Worksheets("Scorecard").Range("L12")
Worksheets("List").Range("B" & i + 3).Copy
ActiveSheet.Paste Destination:=Worksheets("Scorecard").Range("L13")
Worksheets("List").Range("B" & i).Copy
ActiveSheet.Paste Destination:=Worksheets("Scorecard").Range("L27")
Worksheets("List").Range("B" & i + 1).Copy
ActiveSheet.Paste Destination:=Worksheets("Scorecard").Range("L28")
Worksheets("List").Range("B" & i + 2).Copy
ActiveSheet.Paste Destination:=Worksheets("Scorecard").Range("L29")
Worksheets("List").Range("B" & i + 3).Copy
ActiveSheet.Paste Destination:=Worksheets("Scorecard").Range("L30")
Worksheets("List").Range("A" & i).Copy
ActiveSheet.Paste Destination:=Worksheets("scorecard").Range("L19")

Sheets("Scorecard").Activate
fCell.Font.Size = 9
fCell.Font.Name = "Georgia"
bCell.Font.Size = 9
bCell.Font.Name = "Georgia"
hCell.Font.Size = 12
hCell.Font.Name = "Georgia"
Range("L10:L30").Interior.Color = vbWhite
Range("L10:L30").Select
Selection.Borders.LineStyle = xlNone

'ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1

'Range("L10:L13").ClearContents
'Range("L27:L30").ClearContents
'Range("L19").ClearContents
End If
Next i

End Sub

1 reply

Just want to let anyone know that if they would like the answer to this question it is on another site that I posted on...here is the link
https://www.ozgrid.com/forum/index.php?thread/98081-normalise-data-before-pivoting-by-eliminating-duplicate-records-and-gaps/

Thanks