Macro to selects data from several cells and place onto another WS

[Craigside]

Hi,

I use a macro to copy data from fields on a sheet, and place that data into another sheet formatted for printing out. I specify which sets of data are to be selected by putting "L" in adjacent column AE.

It works great on my single sheet, BUT I now need it to function with several worksheets, ie. Search through the collumn in each WS, and if 'L' is present then get the data and put it onto the printout sheet.

Many thanks in advance.

Sample in attached SS.
This is my existing macro:

' Print Labels from Detail List



Sub Labels()



Call AllWorksheetPivots



Dim sh1 As Worksheet

Dim sh2 As Worksheet

Dim r As Integer

Dim c As Integer

Dim p As Integer

Dim r1 As Integer

Dim r2 As Integer

Dim r3 As Integer

Dim r4 As Integer

Dim i As Integer

Dim c1 As Integer



Set sh1 = Sheets("labelData")

Set sh2 = Sheets("LabelTemplate (4)")

'sh2.Cells.MergeCells = False



sh2.Cells.ClearContents



r = 0

c = 1

p = 1



For i = 4 To 5000

If UCase(sh1.Cells(i, 16)) = "L" Then

r = r + 1

If r > 4 Then

r = 1

c = c + 1

End If

If c > 2 Then

p = p + 1

r = 1

c = 1

End If

If r = 1 Then r1 = 3 + (53 * (p - 1))

If r = 2 Then r1 = 6 + 9 + (53 * (p - 1))

If r = 3 Then r1 = 8 + 18 + (53 * (p - 1))

If r = 4 Then r1 = 11 + 27 + (53 * (p - 1))

If r = 5 Then r1 = 14 + 36 + (53 * (p - 1))

If r = 6 Then r1 = 17 + 45 + (53 * (p - 1))

If r = 7 Then r1 = 20 + 54 + (53 * (p - 1))

If r = 8 Then r1 = 23 + 63 + (53 * (p - 1))

If c = 1 Then c1 = 3

If c = 2 Then c1 = 20

sh2.Cells(r1 + 1, c1) = sh1.Cells(i, 7)

sh2.Cells(r1 + 1, c1 + 11) = sh1.Cells(i, 9)

sh2.Cells(r1 + 2, c1) = sh1.Cells(i, 8)

sh2.Cells(r1 + 3, c1) = sh1.Cells(i, 10)

sh2.Cells(r1 + 4, c1 + 1) = sh1.Cells(i, 11)

sh2.Cells(r1 + 4, c1 + 11) = sh1.Cells(i, 12)

sh2.Cells(r1 + 5, c1 + 5) = sh1.Cells(i, 13)

sh2.Cells(r1 + 5, c1 + 11) = sh1.Cells(i, 14)

'sh2.Range(Cells(r1 + 5, c1 + 11), Cells(r1 + 5, c1 + 13)).MergeCells = True



End If

Next i

'Stop

'sh2.PrintOut

sh2.Select

Cells(1, 1).Select

End Sub



End Sub