Easy macro doesnt work

lionginass

New Member
Joined
Jul 29, 2016
Messages
23
Hello.

Have 2 sheets: "Data" and "Suppliers"

Trying to create a vba code, which scans Sheet"Data" column C and if there is value "No" in a cell, then copy columns A:B (same row where value "No" was found)
Then the code should paste that range in a sheet "Suppliers" Column B:C (last row)

Attaching photos of both sheets.
My point is to copy from sheet "Data" Range A1:B2 and paste it to sheet "Suppliers" Range B4:C5

My file is actually much bigger, but i made it simplier to test the code.
My code is here:

Sub Add()


Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LR1 As Integer
Dim LR2 As Integer

Set ws1 = Worksheets("Data")
Set ws2 = Worksheets("Suppliers")

LR1 = ws1.UsedRange.Rows.Count
LR2 = ws2.Cells.SpecialCells(xlCellTypeLastCell).Row + 1

For i = 1 To LR1

If ws1.Range("C" & i).Value = "No" Then
ws1.Range(Cells(i, 2), Cells(i, 3)).Copy ws2.Cells(LR2, 2)
LR2 = LR2 + 1
End If

Next i

Getting error : Method range of object Worksheet failed

Any ideas what is wrong?
 

Attachments

  • Suppliers.PNG
    Suppliers.PNG
    3.4 KB · Views: 0
  • Data.PNG
    Data.PNG
    2.8 KB · Views: 0

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
50,930
Office Version
  1. 365
Platform
  1. Windows
You need to qualify the cells like
VBA Code:
 ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, 2)).Copy ws2.Cells(LR2, 2)
or
VBA Code:
 ws1.Range("A"&i).Resize(,2).Copy ws2.Cells(LR2, 2)
Also your code is copying col B & C, not A & B
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
13,664
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
Although I would use Autofilter to copy them in one go try the changes in red

Rich (BB code):
If ws1.Range("C" & i).Value = "No" Then
ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, 2)).Copy ws2.Cells(LR2, 2)
LR2 = LR2 + 1
End If
or you can lose the first ws1
Rich (BB code):
If ws1.Range("C" & i).Value = "No" Then
Range(ws1.Cells(i, 1), ws1.Cells(i, 2)).Copy ws2.Cells(LR2, 2)
LR2 = LR2 + 1
End If
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
50,930
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback.
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
13,664
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
Just as I mentioned it earlier the way that I would normally do this (although on very large data I do sometimes use an array) is using the Autofilter.
The advantage is it only pastes once rather than pasting every time the loop finds a match and so should be faster.
It might be worth you looking at some time (sample code below).

VBA Code:
Sub Filter_lioinginass()
    Dim ws1 As Worksheet, ws2 As Worksheet

    Application.ScreenUpdating = False
    
    Set ws1 = Worksheets("Data")
    Set ws2 = Worksheets("Suppliers")
    
    With ws1.Range("C1:C" & ws1.Range("C" & Rows.Count).End(xlUp).Row)
    
        .AutoFilter 1, "No"
        
        On Error Resume Next
        .Offset(1, -2).Resize(.Rows.Count - 1, 2).SpecialCells(12).Copy _
        ws2.Range("B" & Rows.Count).End(xlUp).Offset(1)
        On Error GoTo 0
        
    End With
    
    ws1.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

Happy that you now have your code working.
 

Watch MrExcel Video

Forum statistics

Threads
1,118,862
Messages
5,574,716
Members
412,614
Latest member
Tim McLaughlin
Top