CODEWITHSUNDEEP
vbaexcel
San
San

Reputation: 11

This program selecting the whole row, how to limit selection to A to M

Sub Test()

Dim Cell As Range

With Sheets(1)
    ' loop column H untill last cell with value (not entire column)
    For Each Cell In .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
        If Cell.Value = "0" Then
             ' Copy>>Paste in 1-line (no need to use Select)
            .Rows(Cell.Row).Copy Destination:=Sheets(4).Rows(Cell.Row)
        End If
    Next Cell
End With

End Sub

Upvotes: 1

Views: 314

Answers (4)

QHarr
QHarr

Reputation: 84465

Try

Sub Test()

Dim Cell As Range

With Sheets(1)
    ' loop column H untill last cell with value (not entire column)
    For Each Cell In .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
        If Cell.Value = "0" Then
             ' Copy>>Paste in 1-line (no need to use Select)
             Dim targetRow As Long
             targetRow = Cell.Row
            .Range("A" & targetRow & ":H" & targetRow).Copy Destination:=Sheets(4).Rows(Cell.Row)
        End If
    Next Cell
End With

End Sub

But

as that produces a weird repeated paste, did you actually want? Note I replaced the variable cell with currentCell to avoid confusion

Option Explicit

Sub Test()

    Dim currentCell As Range

    With Sheets(1)

        For Each currentCell In .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
        
            If currentCell.Value = "0" Then
        
                Dim targetRow As Long
                targetRow = currentCell.Row
                .Range("A" & targetRow & ":H" & targetRow).Copy Destination:=Sheets(4).Cells(currentCell.Row, 1)

            End If
        
        Next currentCell
    
    End With

End Sub

And:

As noted by @DisplayName you mention column H in your comment. If you intend to loop this then change:

For Each currentCell In .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)

For

 For Each currentCell In .Range("H1:H" & .Cells(.Rows.Count, "H").End(xlUp).Row)

Upvotes: 3

DisplayName
DisplayName

Reputation: 13386

use

.Range("A:M").Rows(Cell.row).Copy Destination:=Sheets(4).Rows(Cell.row)

but you may be in the wrong column, since you're commenting:

' loop column H until last cell with value (not entire column)

while you coding:

For Each Cell In .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).row)

i.e. your looping through column A!

so you may want to code:

Sub Test()

    Dim cell As Range

    With Sheets(1)
        ' loop column H until last cell with value (not entire column)
        For Each cell In .Range("H1:H" & .Cells(.Rows.Count, "A").End(xlUp).row) ' loop through column H cells from row 1 down to last not empty row in column A
            If cell.Value = "0" Then .Range("A:M").Rows(cell.row).Copy Destination:=Sheets(4).Rows(cell.row)
        Next cell
    End With

End Sub

Upvotes: 2

PaichengWu
PaichengWu

Reputation: 2689

try

Sub Test()
  Dim Cell As Range

  With Sheets(1)
    ' loop column H untill last cell with value (not entire column)
    For Each Cell In .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
      If Cell.Value = "0" Then
            ' Copy>>Paste in 1-line (no need to use Select)
        Sheets(4).Range("A:" & Cell.Row & ":M" & Cell.Row).Value = .Range("A:" & Cell.Row & ":M" & Cell.Row).Value
      End If
    Next Cell
  End With
End Sub

Upvotes: 1

CallumDA
CallumDA

Reputation: 12113

Here are some other options for replacing this:

.Rows(Cell.Row).Copy

With either of the following:

  1. Cell.Resize(1,13).Copy
  2. Intersect(Cell.EntireRow, .Range("A:M")).Copy

Or you can loop through the row rather than a specific cell:

Sub Test()
    Dim currentRow As Range
    With Sheets(1)
        ' loop column H untill last cell with value (not entire column)
        For Each currentRow In .Range("A1:M" & .Cells(.Rows.Count, "A").End(xlUp).Row).Rows
            If currentRow.Cells(1, 1).Value = "0" Then
                 ' Copy>>Paste in 1-line (no need to use Select)
                currentRow.Copy Destination:=Sheets(4).Rows(currentRow.Row)
            End If
        Next Cell
    End With
End Sub

Upvotes: 2

Related Questions