Angra2011 0 Posted June 5, 2013 Report Share Posted June 5, 2013 (edited) O código abaixo permite-me copiar os valores da linha selecionada de uma folha ("Registos"), para outra folha ("Resultados"), dentro do mesmo livro (Livro1). Isto é, de cada vez que seleciono uma linha esta é copiada para a folha, mas sempre na linha seguinte dessa folha. Funciona na perfeição como poderão testar. Segue o código: Private Sub Copiar_Click() 'Copia linhas selecionadas para a Folha Resultados neste Livro Dim SourceRange As Range Dim DestRange As Range Dim Lr As Long Lr = LastRow(Sheets("Resultados")) + 1 Set SourceRange = Sheets("Registos").Cells( _ ActiveCell.Row, 1).Range("D1:Y1") With SourceRange Set DestRange = Sheets("Resultados").Range("D" _ & Lr).Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value End Sub Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function Ora o que eu gostaria de saber, e para isso preciso de ajuda, era como fazer o mesmo, mas copiando as linhas para uma folha situada noutro livro (Livro2). Já tentei de diversas maneiras mas não dá. Tenho o seguinte código que abre e fecha o outro livro (Livro2.xls), mas copia sempre a mesma linha. Private Sub Copiar2_Click() 'Copia linhas selecionadas para a Folha Resultados no Livro 2 Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file If bIsBookOpen_RB("Livro2.xls") Then Set DestWB = Workbooks("Livro2.xls") Else Set DestWB = Workbooks.Open("C:\Users\Antonio Gralhas\Desktop\Teste\Livro2.xls") End If 'Change the Source Sheet and range Set SourceRange = Range("D1:Q1") 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("Resultados") Lr = LastRow(DestSh) Set DestRange = DestSh.Range("D" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function Function bIsBookOpen_RB(ByRef szBookName As String) As Boolean ' Rob Bovey On Error Resume Next bIsBookOpen_RB = Not (Application.Workbooks(szBookName) Is Nothing) End Function Ficaria imensamente grato se alguém me pudesse ajudar a resolver este problema, pois preciso do código par terminar um trabalho que estou a desenvolver. Se necessário posso enviar os ficheiros para melhor observação. Obrigado e cumprimentos a todos, Antonio Gralhas Edited June 6, 2013 by Rui Carlos Formatação do código. Link to post Share on other sites
jtiagodias 0 Posted September 26, 2013 Report Share Posted September 26, 2013 Estou a ver este código e acho que pode encaixar na perfeição em algo que eu preciso... Tenho numa folha de cálculo (Base de dados) uma série de informação. Mas queria colocar noutra folha (em linhas contínuas) apenas as linhas que correspondam aos critérios que o utilizador pretende. Este código só utiliza as linhas que o utilizador selecciona certo? O meu obrigado desde já. Link to post Share on other sites
jtiagodias 0 Posted September 27, 2013 Report Share Posted September 27, 2013 Já estive a testar e este código é fantástico. Parabéns e obrigado Angra2011 porque acredito que vá ser útil e muitos utilizadores que, como eu, não têm um conhecimento muito profundo de VBA mas gostam de tentar simplificar o seu dia-a-dia com umas macros simples. Só tenho 1 dúvida grande em relação a este código: i) como é que com este código (copiar linhas para outra folha dentro do mesmo ficheiro) consigo que ele comece a escrever a partir de uma linha pré-definida (por exemplo a parte da célula A10...; A outra questão (bem mais complexa) é como é que neste código conseguiria incluir um ciclo (por exemplo for) para verificar uma condição e sempre que essa condição se verificasse ele automaticamente pegava em cada linha que verificasse a condição e colava sequencialmente tal e qual está agora a fazer... Muito obrigado. Link to post Share on other sites
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now