Pessoal, bom dia.
Eu estava precisando do seguinte:
Tenho uma coluna com uma série de dados. Precisava copiar esses dados e colar em outra planilha numa coluna onde há algumas linhas ocultas.
Acontece que na colagem dos dados o excel passa os dados para as células que estão ocultas também. Gostaria de algum código em que o excel reconhecesse que a linha está oculta e não passasse os dados para ela, pulando assim para a próxima linha, se ela for visível os dados devem ser copiados.
Depois de muito procurar achei este código:
Option Explicit
Public StartWB As Workbook
Public StartWS As Worksheet
Public CopyRng As String
Public Sub CopyToVisibleOnly1()
'Start with cell selected that you want to copy.
Set StartWB = ActiveWorkbook
Set StartWS = ActiveSheet
CopyRng = Selection.Address
'Call CopyToVisibleOnly2 after a five-second delay.
Application.OnTime Now() + TimeValue("0:00:04"), "CopyToVisibleOnly2"
End Sub
Private Sub CopyToVisibleOnly2()
'Declare local variables.
Dim EndWB As Workbook, EndWS As Worksheet
Dim Target As Range, CurrCell As Range
Dim x As Long, FromCnt As Long
On Error GoTo CTVOerr
'Select the range where it should be pasted.
Set Target = Application.InputBox _
(Prompt:="Select the first cell in the Paste range", Type:=8)
Set EndWB = ActiveWorkbook
Set EndWS = ActiveSheet
Set CurrCell = Target.Cells(1, 1)
Application.ScreenUpdating = False
'Copy the cells from the original workbook, one at a time.
StartWB.Activate
StartWS.Activate
For x = 1 To Range(CopyRng).Count
StartWB.Activate
StartWS.Activate
Range(CopyRng).Cells(x, 1).Copy
'Return to the target workbook.
EndWB.Activate
EndWS.Activate
CurrCell.Activate
'Only cells in visible rows in the selected
'range are pasted.
Do While (CurrCell.EntireRow.Hidden = True) Or _
(CurrCell.EntireColumn.Hidden = True)
Set CurrCell = CurrCell.Offset(1, 0)
Loop
CurrCell.Select
ActiveSheet.Paste
Set CurrCell = CurrCell.Offset(1, 0)
Next x
Cleanup:
'Free the object variables.
Set Target = Nothing
Set CurrCell = Nothing
Set StartWB = Nothing
Set StartWS = Nothing
Set EndWB = Nothing
Set EndWS = Nothing
Application.ScreenUpdating = True
Exit Sub
CTVOerr:
MsgBox Err.Description
GoTo Cleanup
End Sub
Ele funciona da forma correta, mas há alguns pontos que eu gostaria de modificar e preciso da ajuda de vocês.
Neste código eu seleciono as células que quero copiar. Após isso eu executo o código. A seguir copio os dados e na sequencia aparece uma mensagem pedindo para eu escolher a célula em que eu quero colar os dados. Escolho, dou um ok e tudo ocorre perfeitamente.
Mas por necessidade gostaria de fazer algo diferente. Queria escolher os dados, copiá-los e a seguir executar o código. E ao executá-lo gostaria que os dados fossem colados diretamente numa célula específica, como D6 por exemplo.
Teria alguma forma de modificar este código para isso? Ou algum outro método?
Muito obrigado!
Postado : 30/07/2012 7:02 am