Copy row to sheet as per dropdown

[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.

 

[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

 

[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)

 

[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

 

[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

 

[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

 

[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..

 

[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

 

[Kashyap]

Thank you so much..

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