Claudio_Paraná

Pessoal, só me ajudam aqui nesta função, ajudem-me a descobrir o erro, porque não está funcionando. Sub Copiar_Dados() Dim wsOrigem As Worksheet Dim wsDestino As Worksheet Workbooks.Open Filename:="d:\cd\copiando.xls" Set wsOrigem = Workbooks("copiando.xls").Worksheets("cadastro") Set wsDestino = Workbooks("abrir_colar_copiar.xls").Worksheets("cadastro") 'como faço para colocar o arquivo atual sem discrimina lo With wsOrigem .Range("a1:m" & Cells(Rows.Count, "m").End(xlUp).Row).Copy Destination:=wsDestino.Range("a1") ' não está funcionado aqui End With 'Fecha o Arquivo Destino e Salva Workbooks("copiando.xls").Close SaveChanges:=True MsgBox "Introdução de Dados Concluída" End Sub

Segue os arquivos. Abrir_colar_copiar.xls copiando.xls

Eu queria que o codigo copiasse o conteudo da planilha do arquivo externo e colasse o conteudo copiado para a planilha cadastro do arquivo aberto. Faltou a outra função Sub Executa() MsgBox "Foram excluídas " & ExcluiLinhasPorCriterio(2, 10000, 8, "empresa") & " linhas" End Sub

Pessoal, segue abaixo o codigo que estou usando, mas tem alguma coisa errada, poderiam me ajudar? Function ExcluiLinhasPorCriterio(ByVal linhaInicial As Integer, ByVal linhaFinal As Integer, ByVal colunaCriterio As Integer, ByVal criterio As String) As Integer Dim linhasExcluidas As Integer Dim i As Integer linhasExcluidas = 0 Workbooks.Open Filename:="d:\cd\copiando.xls" With Sheets("cadastro") i = linhaInicial While i < linhaFinal If CStr(.Cells(i, colunaCriterio).Value) = criterio Then '.Rows(i).Copy .Rows(i).Copy Destination:=Sheets("cadastro").Range("A1") linhasExcluidas = linhasExcluidas + 1 Else i = i + 1 End If Wend End With ExcluiLinhasPorCriterio = linhasExcluidas 'wksDest.Cells(lngLast, "A").PasteSpecial Paste:=xlPasteValues Workbooks("copiando.xls").Close End Function