Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Dados da List View ...
 
Notifications
Clear all

Dados da List View para planilha

 
2024 - VBA & Macros
Post Recente por elosprod 8 anos atrás
4 Posts
2 Usuários
0 Reactions
910 Visualizações
RSS
 elosprod
(@elosprod)
Posts: 0
New Member
Topic starter
 

Boa tarde

preciso de uma ajuda, ainda não sou bom em VBA, preciso enviar os dados de uma list view para planilha mas só consigo enviar planilha da celula A2 pra baixo, preciso que os dados sejam colocados apartir da primeira linha em branco na planilha já preenchida.

Seque o código que encontrei na internet mas esse não funciona da maneira que preciso. e sempre cola os dados no mesmo lugar não acumulando informações.

segue o que achei na internet

Dim i As Integer, j As Integer

'Loop as lignes
For i = 1 To ListView1.ListItems.Count
Cells(i + 1, 1) = ListView1.ListItems(i).Text

'Loop as colunas
For j = 1 To ListView1.ColumnHeaders.Count - 1
Cells(i + 1, j + 1) = ListView1.ListItems(i).ListSubItems(j).Text
Next j
Next i

segue tambem planilha em 4 shared

http://www.4shared.com/file/5khWm_Rqba/ ... e_XML.html

 
Postado : 24/05/2016 1:58 pm
 edilsonfl
(@edilsonfl)
Posts: 227
Estimable Member
 

Poste sua planilha ( compactada) diretamente no fórum, estes sites de hospedagem de arquivos são muito inconvenientes.

Se tiver dúvidas, veja como proceder:
viewtopic.php?f=7&t=3841

 
Postado : 24/05/2016 8:15 pm
 elosprod
(@elosprod)
Posts: 0
New Member
Topic starter
 

Desculpe é que estava ficando muito grande o arquivo, está dando 2,19mb.

Obrigado pela dica

 
Postado : 25/05/2016 7:10 am
 elosprod
(@elosprod)
Posts: 0
New Member
Topic starter
 

:D Resolvido

usei o código copiando direto da planilha e está funcionando

Sheets("xml milenium").Select

 lin = 2
        
        Do Until Sheets("xml milenium").Cells(lin, 4) = ""
        
        If Sheets("xml milenium").Cells(lin, 33) = "copiado" Then
                
     
        Else
        
        Sheets("xml milenium").Cells(lin, 2).Copy Destination:=Sheets("planilha milenium").Range("A1048576").End(xlUp).Offset(1, 0)
        Sheets("xml milenium").Cells(lin, 29).Copy Destination:=Sheets("planilha milenium").Range("A1048576").End(xlUp).Offset(0, 3)
        Sheets("xml milenium").Cells(lin, 4).Copy Destination:=Sheets("planilha milenium").Range("A1048576").End(xlUp).Offset(0, 4)
        Sheets("xml milenium").Cells(lin, 14).Copy Destination:=Sheets("planilha milenium").Range("A1048576").End(xlUp).Offset(0, 5)
        Sheets("xml milenium").Cells(lin, 18).Copy Destination:=Sheets("planilha milenium").Range("A1048576").End(xlUp).Offset(0, 6)
        Sheets("xml milenium").Cells(lin, 19).Copy Destination:=Sheets("planilha milenium").Range("A1048576").End(xlUp).Offset(0, 7)
        Sheets("xml milenium").Cells(lin, 30).Copy Destination:=Sheets("planilha milenium").Range("A1048576").End(xlUp).Offset(0, 8)
        Sheets("xml milenium").Cells(lin, 31).Copy Destination:=Sheets("planilha milenium").Range("A1048576").End(xlUp).Offset(0, 9)
        Sheets("xml milenium").Cells(lin, 1).Copy Destination:=Sheets("planilha milenium").Range("A1048576").End(xlUp).Offset(0, 10)
        Sheets("xml milenium").Cells(lin, 34).Value = Date
        Sheets("xml milenium").Cells(lin, 34).Copy Destination:=Sheets("planilha milenium").Range("A1048576").End(xlUp).Offset(0, 1)
        Sheets("xml milenium").Cells(lin, 33) = "copiado"
        
                       
        End If
        
        lin = lin + 1
  
    Loop
 
Postado : 24/06/2016 9:56 am
Forum Jump:
  Tópico Anterior
Próximo Tópico