Hi Guys,

I am trying to create a macro (unsuccessfully) to:
1. Create a new sheet
2. select a range
3. loop through the range until the range is empty
4. check criteria of cells in range
5. if true copy 2of the cells in the row range to the new worksheet
6. loop through range and create a list in the new worksheet

This is what I got so far:
Sub copyCells()
' Testsubmit Macro

'Declare variables
Dim wb As Workbook
Dim wssheet1 As Worksheet
Dim wssheet2 As Worksheet
Dim ws As Worksheet
Dim newsh As Worksheet
Dim DestinationRange As Range
Dim SourceRange As Range

Dim lRow As Integer


Set wb = ThisWorkbook
Set newsh = wb.Worksheets.Add
newsh.Name = "Orders for next month"
newsh.Range("a1") = "Orders for the month"
newsh.Range("a2") = "Item"
newsh.Range("b2") = "Quantity"

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Do Until IsEmpty(SourceRange)
Set SourceRange = wb.Worksheets("sheet1").Range("a1")
If SourceRange.Offset(1, 0) = "Food" And SourceRange.Offset(1, 0)
"0" Then
Set DestinationRange = wb.Worksheets("Orders for the month").Range("a1")
SourceRange.Offset(1, 0) = DestinationRange.Offset(3, 0)
SourceRange.Offset(1, 5) = DestinationRange.Offset(3, 1)

Loop
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Please help?

Thanks
Albert