[Albino]

Boas.

A minha duvida de hoje prende-se com o seguinte:

Quero copiar determinada células de uma linha para outra folha efectuando duplo clic na célula da coluna A

Ex:

Ao encontrar o nome inscrito na coluna A na célula A3 por Ex. e ao fazer duplo clic  na célula, efetuar copia dos valores para a folha2 na linha livre seguinte.

Tentei utilizar

PrivateSubWorksheet_BeforDoubleClick  e ActiveCell, mas não consegui

Obrigado

 

[jorgerod]

Albino,

Experimenta o seguinte código e adapta:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
‘If the double click occurs on the header row or an empty cell, exit the macro.
If Target.Row = 1 Then Exit Sub
If Target.Row > ActiveSheet.UsedRange.Rows.Count Then Exit Sub
If Target.Column > ActiveSheet.UsedRange.Columns.Count Then Exit Sub

‘Override the default double-click behavior with this function.
Cancel = True

‘Declare your variables.
Dim wks As Worksheet, xRow As Long

‘If an error occurs, use inline error handling.
On Error Resume Next

‘Set the target worksheet as the worksheet whose name is listed in the first cell of the current row.
Set wks = Worksheets(“Folha2”)
‘If there is an error, exit the macro.
If Err > 0 Then
Err.Clear
Exit Sub
‘Otherwise, find the next empty row in the target worksheet and copy the data into that row.
Else
xRow = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row + 1
wks.Range(wks.Cells(xRow, 1), wks.Cells(xRow, 7)).Value = _
Range(Cells(Target.Row, 1), Cells(Target.Row, 7)).Value
End If
End Sub

[Albino]

Boas.

JorgeRod

Segui as tuas dicas e com as alterações efetuadas adaptei o código para os meus propósitos, ficando assim.

______________________

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

 

‘Procurar se a celula está vazia.

If Target.Cells = “” Then

MsgBox “Escolha linha com dados”, vbOKOnly, “Aviso”     ‘Adicionei sta informação

Exit Sub

Else

‘Override the default double-click behavior with this function.

Cancel = True

 

‘Declare your variables.

Dim wks As Worksheet, xRow As Long

‘If an error occurs, use inline error handling.

On Error Resume Next

 

‘Set the target worksheet as the worksheet whose name is listed in the first cell of the current row.

Set wks = Worksheets(“Folha4”)

‘If there is an error, exit the macro.

If Err > 0 Then

Err.Clear

Exit Sub

 

‘Otherwise, find the next empty row in the target worksheet and copy the data into that row.

Else

xRow = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row + 1

wks.Range(wks.Cells(xRow, 1), wks.Cells(xRow, 7)).Value = _

Range(Cells(Target.Row, 1), Cells(Target.Row, 7)).Value

MsgBox “Dados copiados Com Exito”, vbOKOnly, “Informação”   ‘Adicionei esta informação

End If

End If

 

End Sub

_____

Muito Obrigado

Cumprimentos

[jorgerod]

Albino,

 

Ainda bem que te serviu.

BOA!!!!!

 

Abraço.

[Autor]

Artigos