Não funcionou aqui. Dá erro aqui VBA.CDbl(ListView1.ListItems(x).ListSubItems(j).Text),
Consegui que a importação dos dados viesse ok com essas alterações. Só que apenas com esse arquivo especifico que testei a importação inicialmente.
Código: Selecionar todosPrivate Sub CommandButton2_Click()
Dim x As Single
Dim i As Integer
Dim j As Integer
'Limpa planilha
Range("B6").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Worksheets("importar").Range("b6:j2000").ClearContents
Range("B5").Select
i = 6
For x = 1 To ListView1.ListItems.Count
If ListView1.ListItems.item(x).Checked = True Then
Cells(i, 2) = ListView1.ListItems(x).Text
'Loop das colunas
For j = 1 To ListView1.ColumnHeaders.Count - 1
Cells(i, j + 2) = ListView1.ListItems(x).ListSubItems(j).Text
Next j
i = i + 1
End If
Next x
End Sub
Testei um outro arquivo e só aparece na visuaização dos itens a selecionar as 5 primeiras linhas com dados na planilha. Acho que o problema está aqui.
Código: Selecionar todosPrivate Sub carrega_listview()
Dim lin As Integer
Dim Titulo As Integer
Dim dados As Integer
'Se a listview contiver colunas vai eliminar
ListView1.ColumnHeaders.Clear
Application.ScreenUpdating = False
Plan1.Range("B5").Select
conta_colunas = Cells(2, Columns.Count).End(xlToLeft).Column
'Adiciona nome aos cabeçalhos da lisview
For Titulo = 2 To conta_colunas
With ListView1
.Gridlines = True
.View = lvwReport
.FullRowSelect = True
.ColumnHeaders.Add Text:=Plan1.Cells(5, Titulo)
End With
Next Titulo
ListView1.ListItems.Clear
Plan1.Select
lin = 6
Do Until Plan1.Cells(lin, 6) = ""
Set li = ListView1.ListItems.Add(Text:=Plan1.Cells(lin, 2).Value)
For dados = 3 To conta_colunas
li.ListSubItems.Add Text:=Plan1.Cells(lin, dados).Value
Next dados
lin = lin + 1
Loop
'Limpa planilha
Range("B6").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Cells.Select
' Worksheets("importar").Range("B5:J2000").ClearContents
Range("B5").Select
Application.ScreenUpdating = True
End Sub