Snasui Excel Forum

Code: Select all

Sub Unbillede()
       Dim icount As Integer
       Dim sh2Range As Range
       icount = Worksheets("Database").Range("M100000").End(xlUp).Row
        Do
            If Worksheets("Database").Cells(icount, "M") <> 0 Then
                Worksheets("Database").Cells(icount, "M").EntireRow.Copy
                Worksheets("Unbillede").Cells(65536, "F").End(xlUp) _
                    .Offset(1, 0).PasteSpecial xlPasteValues
                Worksheets("Database").Cells(icount, "M").EntireRow.Delete
            End If
        icount = icount - 1
        Loop Until icount = 1
        With Worksheets("Unbillede")
        Set sh2Range = .Range("F1", .Range("M" & Rows.Count).End(xlUp))
       End With
End Sub

Code: Select all

Worksheets("Database").Cells(icount, "M").EntireRow.Copy
Worksheets("Unbillede").Cells(65536, "F").End(xlUp) _
      .Offset(1, 0).PasteSpecial xlPasteValues

Code: Select all

Sub Unbillede()
       Dim icount As Integer
       Dim sh2Range As Range
       icount = Worksheets("Database").Range("M50000").End(xlUp).Row
        Do
            If Worksheets("Database").Cells(icount, "M") <> 0 Then
                Worksheets("Database").Cells(icount, "M").EntireRow.Copy
                Worksheets("Unbillede").Cells(50000, "a").End(xlUp) _
                    .Offset(1, 0).PasteSpecial xlPasteValues
                Worksheets("Database").Cells(icount, "M").EntireRow.Delete
            End If
        icount = icount - 1
        Loop Until icount = 1
        With Worksheets("Unbillede")
        Set sh2Range = .Range("a1", .Range("M" & Rows.Count).End(xlUp))
       End With
End Sub

Code: Select all

Dim rall As Range, r As Range
With Sheets("Database")
    Set rall = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    For Each r In rall
        If r.Value2 >= Sheets("form").Range("b5").Value2 And _
            r.Value2 <= Sheets("form").Range("c5").Value2 And _
            r.Offset(0, 5).Value = Sheets("form").Range("d5").Value Then
            With Sheets("Unbillede")
                With .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0)
                    .Resize(1, 13).Value = r.Resize(1, 13).Value
                End With
            End With
        End If
    Next r
End With