Boa noite, Senhores.
Estou com um problema punk, tenho um arquivo onde as colunas podem variar entre A ... Z ou até mais, já as linhas sempre serão 12, criei o código abaixo mas não esta transportando o valor para uma nova plan, gostaria de uma ajuda dos senhores.
Código
Public Sub SalvarAnaliseDadosAnualTranspose_Exportar_xls()
Dim Count As Integer
Dim fApp As Excel.Application
Dim fBook As Excel.Workbook
Dim fSheet As Excel.Worksheet
Dim i, UltimaColuna As Long
Dim Arquivo As String
Dim Resultado As VbMsgBoxResult
i = SheetAnaliseDadosAnualTranspose.Cells(1, SheetAnaliseDadosAnualTranspose.Cells.Columns.Count).End(xlToLeft).Column
Arquivo = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="Pasta de Trabalho do Excel 97-2003 (*.xls), *.xls", _
Title:="Especifique o nome do arquivo")
If LCase(Arquivo) = "falso" Then Exit Sub
'Range("A1").Select
'Range(Selection, Selection.End(xlToRight)).Select
'Range(Selection, Selection.End(xlDown)).Select
'Selection.Copy
Set fApp = CreateObject("Excel.Application")
Set fBook = fApp.Workbooks.Add
Set fSheet = fApp.ActiveWorkbook.Sheets.Add
fSheet.Name = "Export"
fApp.Visible = False
fSheet.Visible = False
For UltimaColuna = 1 To i
For Count = 1 To 12
With fSheet
.Cells(Count & UltimaColuna).Value = SheetAnaliseDadosAnualTranspose.Cells(Count & UltimaColuna).Value
'MsgBox "Linha: " & Count & vbCrLf & "Coluna: " & UltimaColuna
End With
'Count = Count + 1
Next
'UltimaColuna = UltimaColuna + 1
Next
fSheet.SaveAs Arquivo
fApp.Workbooks.Close
fApp.Quit
Set fSheet = Nothing
Set fBook = Nothing
Set fApp = Nothing
'MsgBox "O arquivo foi salvo com sucesso em [" & Arquivo & "]", vbInformation
Resultado = MsgBox("O arquivo foi salvo com sucesso em [" & Arquivo & "]" & vbCrLf & _
"Deseja visualizar o arquivo?", vbYesNo, "Arquivo Salvo com Sucesso!")
If Resultado = vbYes Then
If Len(Dir(Arquivo)) > 0 Then
fileToOpen = (Arquivo)
Workbooks.OpenText Filename:=fileToOpen, DataType:=xlDelimited, Local:=True
Else
Exit Sub
End If
End If
End Sub
Se a resposta foi útil! Clique na mãozinha ao lado do botão Citar.
Sua dúvida foi respondida? Marque como RESOLVIDO em seus tópicos, usando o botão com marca verde.
Postado : 22/06/2015 8:03 pm