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

Share

Tags