Copy Data from 1 sheet to another based on criteria

Excel&VBA · Nov 24th 2020

Copying Data from Workbooks("Sheet1").Worksheets("Sheet1") Range("A5:BBC5") if that row has a word "king" it should copy the data of complete row and paste it to Workbooks("Sheet2").Worksheets("Sheet2") Range("K10") that sheet.

I am unable to figure it out that why my code is not working.

any help would be highly appreciated.

Code

Sub CopyRows()

 Dim rightend As Integer
 Dim x As Integer
 Dim c As Range
Dim Source As Worksheet
Dim Target As Worksheet

Set Source = Workbooks("Sheet1").Worksheets("Sheet1")
Set Target = Workbooks("Sheet2").Worksheets("Sheet2")
 
 rightend = Source.Range("L" & Columns.Count).End(xlRight).Columns: x = 1
 
 
 For Each c In Source.Range("A5:BBC5" & rightend)
 
 If c.Value = "king" Then
 
 c.EntireRow.Copy Worksheets("sheet2").Range("A" & x)
 
 x = x + 1
 End If
 Next c
 
 Targte.Range("K10").Select
 ActiveSheet.Paste
 
 
End Sub

Display More

dangelor · Nov 24th 2020

Without a workbook to reference, this is my best guess...

Code

Sub CopyRows()
    Dim wkshtSource As Worksheet, wkshtTarget As Worksheet
    Dim lRow As Long, rg As Range, c As Range, i As Long
    
    On Error Resume Next
    Set wkshtSource = Workbooks.Open("Sheet1.xlsx").Worksheets("Sheet1")
    Set wkshtTarget = Workbooks.Open("Sheet2.xlsx").Worksheets("Sheet2")
    On Error GoTo 0
    
    If Not wkshtSource Is Nothing And Not wkshtTarget Is Nothing Then
        lRow = wkshtSource.Cells(Rows.Count, 12).End(xlUp).Row
        Set rg = wkshtSource.Range("A5:BB" & lRow)
        
        For i = 1 To rg.Rows.Count
            Set c = rg.Rows(i).Find("king")
            If Not c Is Nothing Then c.EntireRow.Copy wkshtTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1)
        Next i
        wkshtTarget.Cells(10, 11).Select
    Else
        MsgBox "One or both of the worksheets could not be found. Exiting..."
    End If
End Sub

Display More

Excel&VBA · Nov 25th 2020

dangelor

apologies that i have not uploaded the sheets. But now i have uploaded the sheets which accurate data. to copy paste the data on a condition

Sheet1 has data which is available in row 4 and 5, where code will fetch that in row 4 has word "0f3" then code will copy the exactly data available under word "0f3" to end of the data (Data of row 5 will be copied) and paste into sheet2 range J10 to further...

The code will not copy the data which is before the word "0f3" that is highlighted."

I have pasted the required data into Sheet2 which is required from Sheet1.

dangelor · Nov 25th 2020

Try this...

Code

Sub Copy_Row()
    Dim c As Range
    
    With Workbooks("Sheet1.xlsx").Worksheets("Sheet1")
        Set c = .Rows(4).Find("0f3")
        If Not c Is Nothing Then
            .Range(c.Offset(1), c.Offset(1).End(xlToRight)).Copy Workbooks("Sheet2.xlsx").Worksheets("Sheet2").Cells(10, 11)
        End If
    End With
End Sub

Excel&VBA · Nov 25th 2020

dangelor

Thank you so much if i want to paste the data as transpose how i can add this.

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=True

dangelor · Nov 25th 2020

Code

Sub Copy_Row()
    Dim c As Range

    With Workbooks("Sheet1.xlsm").Worksheets("Sheet1")
        Set c = .Rows(4).Find("0f3")
        If Not c Is Nothing Then
            .Range(c.Offset(1), c.Offset(1).End(xlToRight)).Copy
            Workbooks("Sheet2.xlsx").Worksheets("Sheet2").Cells(10, 11).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        End If
    End With
End Sub

Display More

Excel&VBA · Nov 25th 2020

dangelor

thank you so much for the help.

dangelor · Nov 25th 2020

You are welcome.

Copy Data from 1 sheet to another based on criteria

Participate now!

Share

Tags