Sub bbb()
Dim OutSH As Worksheet, DataSH As Worksheet, StickersSH As Worksheet
Set OutSH = Sheets("Snack Data - Filtered")
Set DataSH = Sheets("Snack Data-Unfiltered")
Set StickersSH = Sheets("Snack Stickers")
DataSH.Range("H1:I1").Value = DataSH.Range("F1").Value
DataSH.Range("H2").Formula = "=""<>""&0"
DataSH.Range("I2").Formula = "=""<> """
DataSH.Range("A:F").AdvancedFilter Action:=xlFilterCopy, criteriarange:=DataSH.Range("H1:I2"), copytorange:=OutSH.Range("A1:F1")
OutSH.Activate
outrow = -4
For Each ce In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If ce <> "Room#" Then
outrow = outrow + 5
StickersSH.Cells(outrow, 1).Value = Cells(ce.Row, "G").Value
StickersSH.Cells(outrow + 1, 1).Value = Cells(ce.Row, "B").Value
StickersSH.Cells(outrow + 2, 1).Value = Cells(ce.Row, "A").Value
StickersSH.Cells(outrow + 3, 1).Value = Cells(ce.Row, "D").Value
StickersSH.Cells(outrow, 2).Value = ""
StickersSH.Cells(outrow + 1, 2).Value = Cells(ce.Row, "C").Value
StickersSH.Cells(outrow + 2, 2).Value = Cells(ce.Row, "F").Value
StickersSH.Cells(outrow + 3, 2).Value = Cells(ce.Row, "E").Value
StickersSH.Cells(outrow, 5).Value = Cells(ce.Row, "K").Value
StickersSH.Cells(outrow + 1, 5).Value = Cells(ce.Row, "F").Value
StickersSH.Cells(outrow + 2, 5).Value = Cells(ce.Row, "E").Value
StickersSH.Cells(outrow + 3, 5).Value = Cells(ce.Row, "H").Value
StickersSH.Cells(outrow, 6).Value = ""
StickersSH.Cells(outrow + 1, 6).Value = Cells(ce.Row, "G").Value
StickersSH.Cells(outrow + 2, 6).Value = Cells(ce.Row, "J").Value
StickersSH.Cells(outrow + 3, 6).Value = Cells(ce.Row, "I").Value
StickersSH.Cells(outrow, 9).Value = Cells(ce.Row, "O").Value
StickersSH.Cells(outrow + 1, 9).Value = Cells(ce.Row, "J").Value
StickersSH.Cells(outrow + 2, 9).Value = Cells(ce.Row, "I").Value
StickersSH.Cells(outrow + 3, 9).Value = Cells(ce.Row, "L").Value
StickersSH.Cells(outrow, 10).Value = ""
StickersSH.Cells(outrow + 1, 10).Value = Cells(ce.Row, "K").Value
StickersSH.Cells(outrow + 2, 10).Value = Cells(ce.Row, "N").Value
StickersSH.Cells(outrow + 3, 10).Value = Cells(ce.Row, "M").Value
End If
Next ce
End Sub
rylo
Bookmarks