Copy row to sheet as per dropdown

K

Kashyap

Hi, I have dropdown in ColH with all the names similar to sheet names. When I
select a name from dropdown macro should copy that row from A:G and paste the
same at A2 & xdown as per the sheet selected.
 
J

Jacob Skaria

Set the Security level to low/medium in (Tools|Macro|Security). 'Launch VBE
using short-key Alt+F11. On the left treeview double click 'This Workbook '.
Drop down to get the SheetChange event. Save. Get back to Workbook.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 8 Then
strSName = Cells(Target.Row, 8)
lngLastRow = ActiveWorkbook.Sheets(strSName).Cells(Rows.Count,
"A").End(xlUp).Row
For lngCol = 1 To 7
ActiveWorkbook.Sheets(strSName).Cells(lngLastRow + 1, lngCol) =
ActiveSheet.Cells(Target.Row, lngCol).Value
Next
End If
End Sub
 
K

Kashyap

Thanks Jacob.. Works just the way I wanted..

Can I also have the sheet name from which the row is pasted? in colI (sheet
where the row is pasted)
 
J

Jacob Skaria

Kashya, you can also avoid the loop..

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 8 Then
strSName = Cells(Target.Row, 8)
lngLastRow = ActiveWorkbook.Sheets(strSName).Cells(Rows.Count,
"A").End(xlUp).Row
arrTemp = ActiveSheet.Range("A" & Target.Row & ":G" & Target.Row)
ActiveSheet.Range("A" & lngLastRow & ":G" & lngLastRow) = arrTemp
End If
End Sub
 
J

Jacob Skaria

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 8 Then
strSName = Cells(Target.Row, 8)
lngLastRow = ActiveWorkbook.Sheets(strSName).Cells(Rows.Count,
"A").End(xlUp).Row
arrTemp = ActiveSheet.Range("A" & Target.Row & ":G" & Target.Row)
ActiveWorkbook.Sheets(strSName).Range("A" & lngLastRow & ":G" & lngLastRow)
= arrTemp
ActiveWorkbook.Sheets(strSName).Range("I" & lngLastRow) = ActiveSheet.Name
End If
End Sub

If this post helps click Yes
 
J

Jacob Skaria

Oops...a mistake

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 8 Then
strSName = Cells(Target.Row, 8)
lngLastRow = ActiveWorkbook.Sheets(strSName).Cells(Rows.Count,
"A").End(xlUp).Row
arrTemp = ActiveSheet.Range("A" & Target.Row & ":G" & Target.Row)
ActiveWorkbook.Sheets(strSName).Range("A" & lngLastRow & ":G" & lngLastRow)
= arrTemp
End If
End Sub
 
K

Kashyap

Hey Jocob, this code worked..

can you help me in editing the line

lngLastRow = ActiveWorkbook.Sheets(strSName).Cells(Rows.Count,
"A").End(xlUp).Row

I now need this to be updated in row xldown +2

Thanks..
 
J

Jacob Skaria

If you mean 2 rows from the last row....

lngLastRow = ActiveWorkbook.Sheets(strSName).Cells(Rows.Count,
"A").End(xlUp).Row + 2


If this post helps click Yes
 
K

Kashyap

Thank you so much.. :)

Jacob Skaria said:
If you mean 2 rows from the last row....

lngLastRow = ActiveWorkbook.Sheets(strSName).Cells(Rows.Count,
"A").End(xlUp).Row + 2


If this post helps click Yes
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top