Notifications
Clear all

Uma ajuda em For Next

6 Posts
4 Usuários
0 Reactions
1,419 Visualizações
(@novaislc)
Posts: 9
Active Member
Topic starter
 

Meu caso é simples de entender, mas não é tão fácil de executar.
Na planilha Nomes, na coluna “A”, tenho uma lista com vários nomes (aproximadamente 700 nomes) e vou copiar esses nomes. Como fazer para que a planilha Book fique com os nomes inseridos no formato mostrado abaixo. São mais de 700 nomes e as respectivas fotos. Inicialmente as fotos (que estão na mesma pasta, serão reduzidas do tamanho original para 3x4) serão posicionadas nas células manualmente. Sei também que possível executar esse processo através de VBA só que ainda não tenho conhecimento para conseguir fazer isso e aceito sugestões.
Nomes Book
A B A B C D E
1 Abrahão 1 Foto1 Foto2 Foto3 Foto4 Foto5
2 Bernardo 2 Abrahão Bernardo Clotilde Daniel Evaldo
3 Clotilde 3 Foto6 Foto7 Foto8 Foto9 Foto10
4 Daniel 4 Fabio Geraldo Humberto Ismael Jonas
5 Evaldo 5 Foto11 Foto12 Foto13 Foto14 Foto15
6 Fabio 6 Laura Maria Nicolino Olivia Pascoal
7 Geraldo 7 Foto16 Foto17 Foto18 Foto19 Foto20
8 Humberto 8
9 Ismael 8 Foto21 Foto22 Foto23 Foto24 Foto25
10 Jonas 10
11 Laura 11 Foto26 Foto27 Foto28 Foto29 Foto30
12 Maria 12
13 Nicolino 13 Foto31 Foto32 Foto33 Foto34 Foto35
14 Olivia 14
15 Pascoal 15 Foto36 Foto37 Foto38 Foto39 Foto40

Até arrisquei fazer, mas o máximo que consegui foi um loop que copia os 25 primeiros nomes. Mas observe que para cada For Next eu preciso alterar manualmente a variável i e o nº da linha de colagem. E vê-se claramente que da forma que está a probabilidade de erros é alta além de que o trabalho será extenuante. Isso sem falar que toda vez que houver modificações todo o trabalho deverá ser refeito. Como está idealizado conseguirei colocar 25 fotos em cada folha de papel tamanho A4.

Sub InserirNomes()
Dim plan As Range
    For i = 1 To 5
        Sheets("Nomes").Cells(i, 1).Copy
        Sheets("Book").Cells(3, i).PasteSpecial
    Next
    For i = 6 To 10
        Sheets("Nomes").Cells(i, 1).Copy
        Sheets("Book").Cells(5, i - 5).PasteSpecial
    Next
    For i = 11 To 15
        Sheets("Nomes").Cells(i, 1).Copy
        Sheets("Book").Cells(7, i - 10).PasteSpecial
    Next
    For i = 16 To 20
        Sheets("Nomes").Cells(i, 1).Copy
        Sheets("Book").Cells(9, i - 15).PasteSpecial
    Next
    For i = 21 To 25
        Sheets("Nomes").Cells(i, 1).Copy
        Sheets("Book").Cells(11, i - 20).PasteSpecial
    Next
End Sub

Desde já agradeço quem puder colaborar.
Obrigado
Luiz

 
Postado : 03/05/2016 1:42 pm
(@adgere)
Posts: 76
Trusted Member
 

Acho q nao esta tão simples de entender... melhor postar uma planilha de exemplo

 
Postado : 03/05/2016 6:56 pm
(@novaislc)
Posts: 9
Active Member
Topic starter
 

Àqueles que puderem ajudar, o link abaixo mostra uma planilha exemplo
Desde já, mais uma vez agradeço
Luiz

https://www.sendspace.com/file/xgslqb

 
Postado : 05/05/2016 11:37 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde NovaisLC

Seja bem-vindo ao fórum!

Como você é novato, sugiro tomar conhecimento do conteúdo dos links abaixo:
viewtopic.php?f=7&t=203
viewtopic.php?f=7&t=7903
viewtopic.php?f=7&t=3841
viewtopic.php?f=7&t=16757
viewtopic.php?f=7&t=12600
viewtopic.php?f=7&t=3371

[]s

Patropi - Moderador

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 05/05/2016 11:56 am
(@mprudencio)
Posts: 2749
Famed Member
 

Com base na sua planilha de exemplo

Troque o seu codigo por este


Sub InserirNomes()
Dim plan            As Range
Dim WNULinha        As Long
Dim WBLinha         As Long
Dim WBColuna        As Long
Dim WN              As Worksheet
Dim WB              As Worksheet


Set WN = Sheets("Nomes")
Set WB = Sheets("Book")

WNULinha = WN.Range("A" & Rows.Count).End(xlUp).Row
WBLinha = 3
WBColuna = 1

    For i = 1 To WNULinha
        WB.Cells(WBLinha, WBColuna).Value = WN.Cells(i, 1).Value
        WBColuna = WBColuna + 1
        
            If i Mod 5 = 0 Then
            WBLinha = WBLinha + 2
            WBColuna = 1
            End If
      
    Next
    
  
End Sub

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 05/05/2016 12:26 pm
(@novaislc)
Posts: 9
Active Member
Topic starter
 

Agradeço enormemente sua colaboração. Caiu como uma luva nas minhas necessidades. Espero um dia retribuir tua ajuda. Um forte abraço :D

 
Postado : 07/05/2016 12:46 pm