Results 1 to 5 of 5
  1. #1
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Copy row with criteria (2000 sr 1)

    My mcaro not work!

    Sub COPY_LINES()

    Dim RNG As Range
    Dim C
    Dim COUNT As Integer

    Set RNG = Sheets("RATE").Range("K3:K" & Cells(11, 1).End(xlDown).Row)

    COUNT= 2

    For Each C In RNG.Cells

    If C.Value = "NESSUNA PRATICA TROVATA (ESTINTA)" Then

    COUNT = COUNT + 1

    Range("A" & C.Row & ":AJ" & C.Row).Copy

    Sheets("ESTINTE").Range("A" & COUNT).PasteSpecial

    Application.CutCopyMode = False

    End If

    Next C

    End Sub

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Copy row with criteria (2000 sr 1)

    Does this work better? I referred explicitly to the worksheet throughout.

    Sub Copy_Lines()
    Dim rng As Range
    Dim c
    Dim cnt As Integer
    Set rng = Sheets("RATE").Range("K3:K" & _
    Sheets("RATE").Cells(11, 1).End(xlDown).Row)
    cnt = 2
    For Each c In rng.Cells
    If c.Value = "NESSUNA PRATICA TROVATA (ESTINTA)" Then
    cnt = cnt + 1
    Sheets("RATE").Range("A" & c.Row & ":AJ" & c.Row).Copy
    Sheets("ESTINTE").Range("A" & cnt).PasteSpecial
    Application.CutCopyMode = False
    End If
    Next c
    End Sub

  3. #3
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Copy row with criteria (2000 sr 1)

    Sorry Hans ...
    How to delete the entire line from RATE, after copy into ESTINTE???

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Copy row with criteria (2000 sr 1)

    The code becomes different because you must loop backwards through the rows if you want to delete some of them:

    Sub Cut_Lines()
    Dim r As Long
    Dim cnt As Long
    cnt = 2
    For r = Sheets("RATE").Range("K1").End(xlDown).Row To 3 Step -1
    If Sheets("RATE").Range("K" & r) = "NESSUNA PRATICA TROVATA (ESTINTA)" Then
    cnt = cnt + 1
    Sheets("RATE").Range("A" & r & ":AJ" & r).Copy
    Sheets("ESTINTE").Range("A" & cnt).PasteSpecial
    Sheets("Rate").Range("A" & r).EntireRow.Delete
    End If
    Next r
    End Sub

  5. #5
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Copy row with criteria (2000 sr 1)

    sorry for delay, tks!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •