Copy if greater than zero.

[aliaslamy2k]

Dear Experts,

Please I need a VBA which conditionally copy cells if only cell is greater that 0 zero and paste in Sheet 2 .

Example date :

<TABLE style="WIDTH: 96pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=128><COLGROUP><COL style="WIDTH: 48pt" span=2 width=64><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 48pt; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=20 width=64>AAA</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 width=64>1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=20>BBB</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63>0</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=20>CCC</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63>4</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=20>DDD</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63>45</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=20>EEE</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63>0</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=20>FFF</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63>0</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=20>GGG</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63>3</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=20>HHH</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63>5</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=20>III</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63>6</TD></TR></TBODY></TABLE>


Answer should be like this.

<TABLE style="WIDTH: 96pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=128><COLGROUP><COL style="WIDTH: 48pt" span=2 width=64><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 48pt; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20 width=64>AAA</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 width=64>1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20>CCC</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65>4</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20>DDD</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65>45</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20>GGG</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65>3</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20>HHH</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65>5</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20>III</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65>6</TD></TR></TBODY></TABLE>


Rgds,
AB

 

[VoG]

Try

Sub cpy()
Dim LR As Long, i As Long
With Sheets("Sheet2")
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        With .Range("B" & i)
            If .Value <> 0 Then .Offset(, -1).Resize(, 2).Copy Destination:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End With
    Next i
End With
End Sub

 

[aliaslamy2k]

Hi Vog,

It works wonderful, but please advise how can i ammend the range ?

Example : Search in range = AU5:AV45 and if its greater than 0 zero then paste in Sheet 1 in cell A44:B44 and downwards.

Sorry if i am bothering too much


Rgds,
AB

 

[VoG]

Try

Sub cpy()
Dim LR As Long, i As Long
LR = WorksheetFunction.Max(44, Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row)
With Sheets("Sheet2")
    For i = 5 To 45
        With .Range("AV" & i)
            If .Value <> 0 Then
                .Offset(, -1).Resize(, 2).Copy Destination:=Sheets("Sheet1").Range("A" & LR)
                LR = LR + 1
            End If
        End With
    Next i
End With
End Sub

 

[aliaslamy2k]

You are too good Mr Vog.


Thanks a million.



Rgds,
AB

 

[aliaslamy2k]

Hello Again,


I am some problem here, I am not getting the result when I paste the above code in my actual worksheet. But same code if I enter in a blank or new workbook it works fantastic. Below is my actual data which I want to copy in Sheet 1


<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Calibri,Arial; FONT-SIZE: 11pt" border=1 cellSpacing=0 cellPadding=0><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD> </TD><TD>AZ</TD><TD>BA</TD></TR><TR style="HEIGHT: 25px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD style="TEXT-ALIGN: left; FONT-FAMILY: Courier New; FONT-SIZE: 10pt">AFB</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #f0f0f0; FONT-FAMILY: Courier New; FONT-SIZE: 10pt">0</TD></TR><TR style="HEIGHT: 19px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD style="FONT-FAMILY: Courier New; FONT-SIZE: 10pt">AFE</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffc7ce; FONT-FAMILY: Courier New; COLOR: #800080; FONT-SIZE: 10pt">6</TD></TR><TR style="HEIGHT: 19px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD style="FONT-FAMILY: Courier New; FONT-SIZE: 10pt">AFG</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffc7ce; FONT-FAMILY: Courier New; COLOR: #800080; FONT-SIZE: 10pt">1</TD></TR><TR style="HEIGHT: 19px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">9</TD><TD style="FONT-FAMILY: Courier New; FONT-SIZE: 10pt">AFR</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffc7ce; FONT-FAMILY: Courier New; COLOR: #800080; FONT-SIZE: 10pt">13</TD></TR><TR style="HEIGHT: 20px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">10</TD><TD style="FONT-FAMILY: Courier New; FONT-SIZE: 10pt">AFT</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #f0f0f0; FONT-FAMILY: Courier New; FONT-SIZE: 10pt">0</TD></TR><TR style="HEIGHT: 20px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">11</TD><TD style="FONT-FAMILY: Courier New; FONT-SIZE: 10pt">AFX</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffc7ce; FONT-FAMILY: Courier New; COLOR: #800080; FONT-SIZE: 10pt">26</TD></TR><TR style="HEIGHT: 20px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">12</TD><TD style="FONT-FAMILY: Courier New; FONT-SIZE: 10pt">AGA</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffc7ce; FONT-FAMILY: Courier New; COLOR: #800080; FONT-SIZE: 10pt">3</TD></TR></TBODY></TABLE>
<TABLE style="BORDER-BOTTOM-STYLE: groove; BORDER-BOTTOM-COLOR: #00ff00; BORDER-RIGHT-STYLE: groove; BACKGROUND-COLOR: #fffcf9; BORDER-TOP-COLOR: #00ff00; FONT-FAMILY: Arial; BORDER-TOP-STYLE: groove; COLOR: #000000; BORDER-RIGHT-COLOR: #00ff00; FONT-SIZE: 10pt; BORDER-LEFT-STYLE: groove; BORDER-LEFT-COLOR: #00ff00"><TBODY><TR><TD>Spreadsheet Formulas</TD></TR><TR><TD><TABLE style="FONT-FAMILY: Arial; FONT-SIZE: 9pt" border=1 cellSpacing=0 cellPadding=2><TBODY><TR style="BACKGROUND-COLOR: #cacaca; FONT-SIZE: 10pt"><TD>Cell</TD><TD>Formula</TD></TR><TR><TD>BA6</TD><TD>=COUNTIF($W$6:$AH$1226,AZ6)</TD></TR><TR><TD>BA7</TD><TD>=COUNTIF($W$6:$AH$1226,AZ7)</TD></TR><TR><TD>BA8</TD><TD>=COUNTIF($W$6:$AH$1226,AZ8)</TD></TR><TR><TD>BA9</TD><TD>=COUNTIF($W$6:$AH$1226,AZ9)</TD></TR><TR><TD>BA10</TD><TD>=COUNTIF($W$6:$AH$1226,AZ10)</TD></TR><TR><TD>BA11</TD><TD>=COUNTIF($W$6:$AH$1226,AZ11)</TD></TR><TR><TD>BA12</TD><TD>=COUNTIF($W$6:$AH$1226,AZ12)</TD></TR></TBODY></TABLE></TD></TR></TBODY></TABLE>

Excel tables to the web >> Excel Jeanie HTML 4

 

[VoG]

Try this

Sub cpy()
Dim LR As Long, i As Long
LR = WorksheetFunction.Max(44, Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row)
With Sheets("Sheet2")
    For i = 5 To 45
        With .Range("BA" & i)
            If .Value <> 0 Then
                .Offset(, -1).Resize(, 2).Copy
                Sheets("Sheet1").Range("A" & LR).PasteSpecial Paste:=xlPasteValues
                LR = LR + 1
            End If
        End With
    Next i
End With
End Sub

 

[Dazzawm]

Hi VoG. To aid my learning could you explain this line please

If .Value <> 0 Then .Offset(, -1).Resize(, 2).Copy Destination:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)

 

[VoG]

Does this help:

If the value isn't 0

If .Value <> 0 Then

look one cell to the left

.Offset(, -1)

resize that range to be 2 columns wide

.Resize(, 2)

copy that range and paste it under the last cell in column A of Sheet1

.Copy Destination:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)

 

[aliaslamy2k]

Hi Vog,

I am getting error " Run-time error '1400': Application-defined or object-defined error"

and when I run the code in excel sheet, one popup mesage comes " x 400 "


Am I doing anything wrong ? I just copy pasted the code in sheet 2 VBA



Rgds,
AB