Copy entire row from one sheet to another if cells in column A are equal

Hi all,

I need help concerning an excel vba code which is actually copying the entire row from sheet1 to sheet2 when cell in the first column A of both sheets are equal.

Let's say that cell A2 in sheet2 is equal to cell A5 in sheet1, then the code will copy the entire row as from A5 in sheet1 and paste it in the first blank cell of A2 in sheet2.

So far the code is working correctly but when there are same data in two different cells in column A in sheet2, the code works only for the first one and skip the second one.

I need to modify the below code so that even if there are several cells in column A in sheet2 that have same data, it will copy the corresponding row from sheet1.

Pls find below an example for better understanding as I'm unable to attached the workbook.

In my workbook, when I run the macro from sheet2, it should fill rows 2,3 and 4 as from column E (which is the first blank cell) but unfortunately it works only for rows 2 and 4 due to same data in cells A2 and A3 in column A.

Sheet1

	A	B	C	D
1	IMPECHNUM	CLIENAAGE	CLIENARES	IMPDOSEMP
2	4534	10	018	0004362
3	7295	40	040	0021867

Sheet2

	A	B	C	D	E	F	G	H
1	IMPECHNUM	IMPECHPAY	AGENCE	CODE RESP	IMPECHNUM	CLIENAAGE	CLIENARES	IMPDOSEMP
2	4534	0004362	10	018	4534	10	018	0004362
3	4534	0028662	10	018
4	7295	0021867	40	040	7295	40	040	0021867

Here is the code that I'm using.

----------------
Dim shtImport As Worksheet
Dim shtMain As Worksheet
Set shtImport = ThisWorkbook.Sheets("Sheet2")
Set shtMain = ThisWorkbook.Sheets("Sheet1")

'From Main to Data
Dim rngImpTitles As Range
Set rngImpTitles = shtImport.Rows(1)
Dim rngImpNames As Range
Set rngImpNames = shtImport.Columns(1)

Dim CopyColumn As Long
Dim CopyRow As Long
Dim foundRow As Long
Dim foundCol As Long

On Error Resume Next
'for each column in row 1 of import sheet
For CopyColumn = 1 To shtMain.Cells(1, shtMain.Columns.Count).End(xlToLeft).Column
foundCol = rngImpTitles.Find(shtMain.Cells(1, CopyColumn).Value2).Column
If Err.Number <> 0 Then
' MsgBox "Not such a col title in importsheet for " & vbNewLine & _
' shtMain.Cells(1, CopyColumn)
Err.Clear
GoTo skip_title
End If


For CopyRow = 1 To shtMain.Cells(shtMain.Rows.Count, 1).End(xlUp).Row
foundRow = rngImpNames.Find(shtMain.Cells(CopyRow, 1)).Row
If Err.Number <> 0 Then
' MsgBox "Not such a row name in importsheet for " & vbNewLine & _
' shtMain.Cells(CopyRow, 1)
Err.Clear
GoTo skip_row
End If

If Len(shtMain.Cells(CopyRow, CopyColumn)) <> 0 Then
shtMain.Cells(CopyRow, CopyColumn).Copy shtImport.Cells(foundRow, foundCol)
End If

skip_row:
Next CopyRow
skip_title:
Next CopyColumn

------------------------
Hope that someone will be able to help me on this issue.

Hi XLAdept,

Thanks for your reply,

I have tried your code but I have received this error msg (Loop without Do) and the "Loop While" in the below code highlighted

“End If: Loop While Not foundRange Is Nothing”

I have tried several times to attach an example but unfortunately it’s not possible.

In the case that you need a sample, will it be possible to send it directly to you via email?

Regards

Hi,

Finally, I have been able to attach a sample.

I have just try your amended code in my worksheet, but it still not working as this time the macro keep running on.

On sheet2 you have three buttons, the "RUN1" button runs my previous code so that you can see the previous result. The "Reset" button will then reset what the "RUN1" button did. And finally the "RUN2" button will run the last code that you've sent to me.

When you click on the RUN1 button you will see that rows 2 and 4 will be filled as from column S with the corresponding data from sheet1 and the row 3 will remain blank as from same column.

In my example, the cell A2 and A3 in sheet2 are equal so the row 3 should be filled with same data than that of row 2.

Hope that you will be able to help me.

Thanking you in advance.

Scal

Hi XLAdept

It is working now.

Many thanks for your help.

Hi XLAdept,

Your code is working correctly, but somehow in my project I can have three or four cells in column A which have the same number.

For these cases, your code is doing part of the job as only two rows are being filled.

Will it be possible for you to help me to amend the code again.

I have attached a new example. “RUN2” button will run your new code.

In the attached workbook plse find also row 4 & 5 in sheet 2 which should be filled.

It is the last thing that I need to sort out to finish my project.

Regards

Scal

Hi XLAdept,

Excellent! It is working well now.

Thank you very much.

Scal