Copy data from one worksheet to other based on condition - vba

Question

I am trying to copy data from one worksheet to another blank worksheet in a workbook. It has three columns where in I want to search a specific 'Unit' value and just copy all of the records with similar 'Unit' values into second worksheet with similar column structure.
**Doc_number** **Doc_version** **Unit**
43449 01 D013-LAG R
43450 02 D013-LAG R
43451 01 D013-DAMP
43452 02 D013-DAMP
Output should be like this if I provide D013-LAG R as input value ;
**Doc_number** **Doc_version** **Unit**
43449 01 D013-LAG R
43450 02 D013-LAG R
I want to paste the selected column to the DELIVERY sheet like if I pass 'Unit' value as 'D03-LAG R' then the output in the DELIVERY file should be just like as follows;
Doc_version Unit
01 D013-LAG R
02 D013-LAG R
It's more like I want to select entire row and then paste the data to another worksheet to the columns I want to. I don't want entire row to be pasted as it is.
I don't have much experience in VBA and have already tried doing the code which results in copying of the last record encountered in the loop. Need your advice.
Sub Row_Copy()
Dim sheet1 As Worksheet, sheet2 As Worksheet
Dim i As Integer, k As Integer
Dim Sheet1LR As Long, Sheet2LR As Long
Set sheet1 = Sheets("MASTER")
Set sheet2 = Sheets("DELIVERY")
Sheet1LR = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
Sheet2LR = Sheet2.Range("A" & Rows.Count).End(xlUp).Row + 1
i = 2
k = Sheet2LR
Do Until i = Sheet1LR
If Trim(sheet1.Cells(i, 26).Value) = "D013-LAG R" Then
With sheet1
.Range(.Cells(i, 1), .Cells(i, 26)).Copy
End With
With sheet2
.Cells(k, 1).PasteSpecial
.Cells(k, 1).Offset(1, 0).PasteSpecial
End With
End If
k = k + 1
i = i + 1
Loop
MsgBox (Complete)
ActiveWorkbook.Save
Application.ScreenUpdating = False
End Sub
This is the latest code I am using;
Sub CommandButton1_Click()
Dim LSearchRow As Long
Dim LCopyToRow As Long
Dim CopyFromSht As Worksheet
Dim CopyToSht As Worksheet
Dim LCnt As Long
On Error GoTo Err_Execute
Set CopyFromSht = Workbooks("TestRow.xlsm").Sheets("MASTER")
Set CopyToSht = Workbooks("TestRow.xlsm").Sheets("DELIVERY")
With CopyFromSht
'Start search in row 4
LSearchRow = .Range("A" & Rows.Count).End(xlUp).Row
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2
For LCnt = 2 To LSearchRow
'If value in column Z = "Unit as needed", copy entire row to Sheet2
If .Range("Z" & LCnt).Value = "D013-LAG R" Then
'Select row in Sheet1 to copy
.Rows(LCnt).Copy Destination:=CopyToSht.Rows(LCopyToRow)
'Move counter to next row
LCopyToRow = LCopyToRow + 1
End If
Next LCnt
End With

Answer 1

I wrote a macro that might give you an idea how to resolve your problem:
Sub CopyRows()
' Variables
Dim row_src As Integer
Dim row_dest As Integer
' Inizialize row within destination sheet
row_dest = 1
' Loop over all rows in source sheet
For row_src = 1 To 32767
' Go to correct cell within source sheet
Sheets("Source").Select
Range("B" & CStr(row_src)).Select
' Done if this row is empty
If (ActiveCell.Value = "") Then
Exit For
End If
' Copy row if it's the header or if match found
If (row_src = 1) Or (ActiveCell.Value = "D013-LAG R") Then
' Copy source row
Rows(CStr(row_src) & ":" & CStr(row_src)).Select
Selection.Copy
' Go to destination row
Sheets("Destination").Select
Rows(CStr(row_dest) & ":" & CStr(row_dest)).Select
' Copy row
ActiveSheet.Paste
' Make sure next row is copied on the right place
row_dest = row_dest + 1
End If
Next
End Sub
In case you want to copy only a few columns from the source to the destination sheet, try this:
' Copy columns B to E of source row
Range("B" & CStr(row_src) & ":E" & CStr(row_src)).Select
Selection.Copy
' Go to destination
Sheets("Destination").Select
Range("B" & CStr(row_dest)).Select
' Copy these columns
ActiveSheet.Paste
In case the columns to be copied are not consecutive (for instance B, D and F):
Range("B" & CStr(row_src) & ",D" & CStr(row_src) & ",F" & CStr(row_src)).Select
Range("F" & CStr(row_src)).Activate
Selection.Copy
By the way, I don't know this all by heart.
You can easily find out the details by executing within Excel:
- Menu View/Macro/Register Macro (or something similar; I got the Italian version)
- Do manually anything you want to automate
- Menu View/Macro/Interrput registration
- Menu View/Macro/View/Modify
I hope this helps you