CODEWITHSUNDEEP
vbaexcel
chicken_milk
chicken_milk

Reputation: 1

VBA macro for copying conditional data to specific cells

I'm new to programming in VBA and I'm looking To take data from different worksheets that matches a condition. Then copy and paste from one specific cell to another specific cell 7 times. The code I have doesn't work and I'm looking to improve it. As I run the code I get flagged for Run time error '1004' Method 'Range of object '_Worksheet' failed at the beginning of the IF statement.

 Sub CopyValues()

 'Declare variables
 'Declare sheet variables
 Dim Sourcews As Worksheet
 Dim Pastews As Worksheet

 'Declare counter variables
 Dim i As Integer
 Dim n As Integer
 Dim lastrow As Long

 Set Sourcews = ThisWorkbook.Sheets("Source")
 Set Pastews = ThisWorkbook.Sheets("Paste")

  lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

 For i = 3 To lastrow

 If Sourcews.Range(i, "AA").Value = "Needed Value" Then

    Pastews.Cells("C:18").Paste
    Pastews.Cells("D:18").Paste
    Pastews.Cells("E:18").Paste
    Pastews.Cells("F:18").Paste
    Pastews.Cells("G:18").Paste
    Pastews.Cells("H:18").Paste



End If

Next

Upvotes: 0

Views: 1345

Answers (5)

Cyril
Cyril

Reputation: 6829

I was working through the duplicate question for this and provided this answer:

Try:

Sub CopyValues()

'Declare counter variables
Dim i As Integer, j as Integer, lastrow As Long
'Declare variables
Dim Sourcedataws As Worksheet, WStotransfer As Worksheet
'Declare sheet variables
Set Sourcedataws = ThisWorkbook.Sheets("Source Data")
Set WStotransferws = ThisWorkbook.Sheets("WStotransfer")

lastrow = Sourcedataws.Cells(Sourcedataws.Rows.Count, "A").End(xlUp).Row

WStotransferws.Range("C18:I18").ClearContents

For i = 2 To lastrow
If WStotransferws.Range("I18").Value="" Then
    If Sourcedataws.Range("AA" & i).Value = "Condition" Then
        Sourcedataws.Range("A"&i).Copy 
        j=WStotransferws.Cells(18, WStotransferws.Columns.Count).End(xlToLeft).Column
        WStotransferws.Cells(18,j+1).PasteSpecial xlPasteValues
        End If
    Else
    End If
Next i

End Sub

Other post found: VBA Need a Nested Loop to shift columns

There's a long conversation with the poster about details that were not in the post.

Upvotes: 0

Jarom
Jarom

Reputation: 1077

Aside from some syntax errors that others have discussed, you haven't specified what is bieng copied before you try to use the .paste method. I would just avoid the copy and paste methods (they are inefficient) and set the cells equal to the value of the range in the if statement like so:

Sub CopyValues()

 'Declare variables
 'Declare sheet variables
 Dim Sourcews As Worksheet
 Dim Pastews As Worksheet

 'Declare counter variables
 Dim i As Integer
 Dim n As Integer
 Dim lastrow As Long

 Set Sourcews = ThisWorkbook.Sheets("sheet1")
 Set Pastews = ThisWorkbook.Sheets("sheet2")

  lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

 For i = 3 To lastrow

If Sourcews.Range("AA" & i).Value = "Needed Value" Then

    Pastews.Range("C18") = Sourcews.Range("AA" & i).Value
    Pastews.Range("D18") = Sourcews.Range("AA" & i).Value
    Pastews.Range("E18") = Sourcews.Range("AA" & i).Value
    Pastews.Range("F18") = Sourcews.Range("AA" & i).Value
    Pastews.Range("G18") = Sourcews.Range("AA" & i).Value



End If

Next

End Sub

Or you could set the value as a variable for cleaner looking code, like this:

Sub CopyValues()

 'Declare variables
 'Declare sheet variables
 Dim Sourcews As Worksheet
 Dim Pastews As Worksheet

 'Declare counter variables
 Dim i As Integer
 Dim n As Integer
 Dim lastrow As Long
 Dim x As String

 Set Sourcews = ThisWorkbook.Sheets("sheet1")
 Set Pastews = ThisWorkbook.Sheets("sheet2")

  lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

 For i = 3 To lastrow

If Sourcews.Range("AA" & i).Value = "Needed Value" Then

    x = Sourcews.Range("AA" & i).Value
    Pastews.Range("C18") = x
    Pastews.Range("D18") = x
    Pastews.Range("E18") = x
    Pastews.Range("F18") = x
    Pastews.Range("G18") = x



End If

Next

End Sub

Or, to make the code even more concise, you can combine the range that is receiving the copied value as Pastews.Range("C18:G18") = x like this:

Sub CopyValues()

 'Declare variables
 'Declare sheet variables
 Dim Sourcews As Worksheet
 Dim Pastews As Worksheet

 'Declare counter variables
 Dim i As Integer
 Dim n As Integer
 Dim lastrow As Long
 Dim x As String

 Set Sourcews = ThisWorkbook.Sheets("sheet1")
 Set Pastews = ThisWorkbook.Sheets("sheet2")

  lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

 For i = 3 To lastrow

If Sourcews.Range("AA" & i).Value = "Needed Value" Then

    x = Sourcews.Range("AA" & i).Value
    Pastews.Range("C18:G18") = x

End If

Next

End Sub

I know I posted a lot, but I wanted to show you a progression of how your could can be more concise and efficient. I hope it helps.

Upvotes: 0

Vityata
Vityata

Reputation: 43595

The If should be like this:

If Sourcews.Range("AA"&i).Value = "Needed Value" Then

Then in the Pastews.Cells, it should be refered to the Worksheet like this:

pastews.Range("A18").Copy Destination:=pastews.Range("H18")

or 

pastews.Cells(18,1).Copy Destination:=pastews.Cells(18,8)

Here is the MSDN article about ranges in VBA - it's worth reading - https://msdn.microsoft.com/en-us/vba/excel-vba/articles/range-object-excel

Upvotes: 0

SJR
SJR

Reputation: 23081

Try this. I'm assuming you want to paste into row 18 and then 19 etc, and not 18 repeatedly!

Sub CopyValues()

'Declare variables
'Declare sheet variables
Dim Sourcews As Worksheet
Dim Pastews As Worksheet

'Declare counter variables
Dim i As Long
Dim n As Long
Dim lastrow As Long

Set Sourcews = ThisWorkbook.Sheets("Source")
Set Pastews = ThisWorkbook.Sheets("Paste")

lastrow = Sourcews.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
n = 18

For i = 3 To lastrow
    If Sourcews.Cells(i, "AA").Value = "Needed Value" Then
        Sourcews.Cells(i, "AA").Copy Pastews.Cells(n, "C").Resize(, 6)
        n = n + 1
    End If
Next

End Sub

Upvotes: 2

TBlock
TBlock

Reputation: 71

Instead of using .Cells("C:18") use .Range("C18"). For questions like this, you can also try recording a macro and learning code from what Excel tells you.

Upvotes: 0

Related Questions