Copiar intervalo formatado

[Guima]

Boa noite senhores,

Estou precisando fazer uma rotina que irá copiar o intervalo de Sheets("Contra").Rows("34:65") de acordo com o número de vezes que houver no" textnumber".

Por exemplo, se no textnumber houver o número 8, esse intervalo deverá ser copiado 8 vezes e assim por diante.


Acontece que preciso que esse intervalo seja copiado sempre abaixo do último intervalo que foi copiado.

Importante dizer que tais intervalos que estão sendo copiados são os dados e a formatação.

E é ai que estou tendo dificudades em criar a rotina. Utilizando o gravador de macros cheguei próximo, vide o código abaixo, porém eu preciso que essa rotina se repita o número de vezes que estiver em txtnumber.

Código: Selecionar todos

Sub Copia()

    Rows("35:64").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=15
    Rows("66:66").Select
    ActiveSheet.Paste  
    
End Sub

Espero que tenha dado pra entender o problema e que alguém possa me ajudar.

Abraço

[Mauro Coutinho]

Você quer dizer : que o intervalo de Sheets("Contra").Rows("34:65") irá ser COPIADO somente uma vez e COLADO a quantidade de vezes que constar em txtnumber ?

É isto ?

[Guima]

Exatamente isso Mauro.

[Mauro Coutinho]

Guima, pelo que expos, estaremos trabalhando com endereços fixos ("34:65") Totalizando 32 linhas, incluindo a 34, e, apos copiar repetindo 8 vezes a área Copiada colando sempre abaixo da ultima linha :
Lógica aplicada :
Área Copiada : 34 a 65 = 32

Colar 8 vezes :
1ª - na Linha 66
2ª - 66 + 32 = Linha 98
3ª - 98 + 32 = Linha 130
4ª - 130 + 32 = Linha 162
5ª - 162 + 32 = Linha 194
6ª - 194 + 32 = Linha 226
7ª - 226 + 32 = Linha 258
8ª - 258 + 32 = Linha 290
então, se for isto, adaptando da propria ajuda do VBA usando a Instrução While...Wend :

Código: Selecionar todos

Sub Copia()
Dim i As Integer

    Rows("34:65").Copy
    ActiveWindow.SmallScroll Down:=15

    i = 66 'Proxima Linha apos a 65

    Dim Counter
    Counter = 0    ' Inicialize variável.
    
    While Counter < 8    ' Teste valor do Contador 8 vezes.
        Counter = Counter + 1    ' Incrementa contador.
        
        Rows(i).PasteSpecial
        
        'Total de Linhas Copiadas
        '65 - 34 = 31 + 1(Incluindo a 34)
        i = i + 32
    
    Wend    ' Encerra o loop While quando Counter > 8.
    
    Application.CutCopyMode = False
    Cells(i, 1).Activate
     
End Sub

É só configurar a variavel para o txtnumber em seu formulário.

[]s

[Mauro Coutinho]

Guima, apos postar a rotina, fiquei pensando se é realmente necessário copiar todas as COLUNAS, se não pularmos Colunas, ou seja não tiver nenhuma totalmente em Branco, poderíamos utilizar a Propriedade CurrentRegion, copiando somente as Colunas com os dados e não as 256 colunas (excel 2003).

Se puder ser assim, troque a instrução :
Rows("34:65").Copy
por esta :
Range("A34").CurrentRegion.Copy

[]s

[Guima]

Olá Mauro,

Testei sua rotina, mas deu um problema, pulando sempre uma linha, e transportando os dados pra uma linha a mais. Creio que o motivo disso, seja que eu não citei que existe linhas em branco na interseção de uma cópia e outra.

Quanto a sua pergunta, realmente não são todas as colunas que estão preenchidas, mas existem colunas em branco entre elas.

De qualquer forma consegui resolver o caso com ajuda do JValq. A rotina ficou assim:

Código: Selecionar todos

Sub Copia()
    Dim i As Integer
    
    For i = 1 To UserForm1.textbox1.Text
        Rows("35:64").Copy Cells((i - 1) * 33 + 68, 1)
    Next
End Sub

Como sempre...Mauro obrigado por mais essa força e toda sua boa vontade. Abs