Solved Export data to another workbook (1 Viewer)

[goncalo]

Hello everyone
I have made the code found below which exports all the data found in the specified range,however now i want to make it so that when filters are selected it will only export the filtered data and not everything but i do not know how to do it

Here's the code i wrote :

Private Sub CommandButton1_Click()
    Dim filePath As String
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim outputText As String
    Dim i As Long, j As Long
  
    Unload Me ' Fecha o userForm
  
    ' Define o worksheet como Dados
    Set ws = ThisWorkbook.Sheets("Dados")
  
    ' Encontra a última linha preenchida na coluna B
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
  
    ' Compila tudo o que está presente nas colunas B até P para depois ser enviado dentro do ficheiro TXT
    For i = 2 To lastRow
        For j = 2 To 19 ' Colunas B até P (2 até 16)
            outputText = outputText & ws.Cells(i, j).Value & vbTab
        Next j
        outputText = outputText & vbNewLine
    Next i
  
    ' Pede ao utilizador para escolher o local onde o ficheiro TXT será guardado
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Selecione onde quer guardar o ficheiro"
      
        If .Show = -1 Then
            filePath = .SelectedItems(1) & "\Valores de Análise.txt"
        Else ' Caso o utilizador tenha fechado o menu de seleção antes de escolher algo, os menus são fechados
            Exit Sub
        End If
    End With
  
    ' Exporta os valores do Sheet2 para um ficheiro TXT
    Open filePath For Output As #1
    Print #1, outputText
    Close #1
  
    ' Mensagem a notificar o utilizador que a exportação foi efetuada com sucesso
    MsgBox "Valores exportados com sucesso para " & filePath, vbInformation, "Exportação de valores"
End Sub

Would appreciate it if anyone could help me out,thanks for reading

 

[Gasman]

I used this method

For Each rngCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible)

 

[goncalo]

my filters are in columns B1-S1 (the headers are present there) and then from column B2 onwards its the data itself
So im supposed to change the line to this?

For Each rngCell In Range("B1:S1" & Range("B1" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible)

 

[Gasman]

I only used column A as I then used the Offset property.

For Each rngCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible)

'    If ActiveCell.Offset(0, 7).Value = "Yes" Then
        Range(rngCell.Address).Cells.Activate
        strDate = ActiveCell.Value
        strType = ActiveCell.Offset(0, 1).Value
        strClient = ActiveCell.Offset(0, 2).Value
        str3rdParty = ActiveCell.Offset(0, 3).Value
        strAmount = Format(ActiveCell.Offset(0, 4).Value, "Currency")
        strRef = ActiveCell.Offset(0, 5).Value
        strMethod = ActiveCell.Offset(0, 6).Value
        strCaseWorker = ActiveCell.Offset(0, 9).Value
        strNotes = ActiveCell.Offset(0, 10).Value
        ActiveCell.Offset(0, 7).Value = "Sent"
        ActiveCell.Offset(0, 8).Value = Date
        
        ' Now populate the outlook fields

You could do the same.
However if you copy the filtered range and paste it, I believe it will only copy visible rows?
Try it and see.

 

[goncalo]

i managed to fix it,here's the code i used if anyone is in need of help

Private Sub CommandButton1_Click()
    Dim filePath As String
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim outputText As String
    Dim i As Long, j As Long
    
    Unload Me ' Fecha o userForm
    
    ' Define o worksheet como Dados
    Set ws = ThisWorkbook.Sheets("Dados")
    
    ' Check if autofilter is applied
    If ws.AutoFilterMode Then
        ' If a filter is applied, export only the visible cells in columns B to P
        ws.AutoFilter.Range.Columns("B:T").SpecialCells(xlCellTypeVisible).Copy
        
      
        Dim tempWB As Workbook
        Set tempWB = Workbooks.Add
        tempWB.Worksheets(1).Paste
        
      
        lastRow = tempWB.Worksheets(1).Cells(tempWB.Worksheets(1).Rows.Count, "B").End(xlUp).Row
        For i = 2 To lastRow
            For j = 2 To 19 ' Colunas B até P (2 até 16)
                outputText = outputText & tempWB.Worksheets(1).Cells(i, j).Value & vbTab
            Next j
            outputText = outputText & vbNewLine
        Next i
        
        ' Close and remove the temporary worksheet
        tempWB.Close False
    Else
      
        lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
        For i = 2 To lastRow
            For j = 2 To 19 ' Colunas B até P (2 até 16)
                outputText = outputText & ws.Cells(i, j).Value & vbTab
            Next j
            outputText = outputText & vbNewLine
        Next i
    End If
    
    ' Pede ao utilizador para escolher o local onde o ficheiro TXT será guardado
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Selecione onde quer guardar o ficheiro"
        
        If .Show = -1 Then
            filePath = .SelectedItems(1) & "\Valores de Análise.txt"
        Else ' Caso o utilizador tenha fechado o menu de seleção antes de escolher algo, os menus são fechados
            Exit Sub
        End If
    End With
    
    ' Exporta os valores do Sheet2 para um ficheiro TXT
    Open filePath For Output As #1
    Print #1, outputText
    Close #1
    
    ' Mensagem a notificar o utilizador que a exportação foi efetuada com sucesso
    MsgBox "Valores exportados com sucesso para " & filePath, vbInformation, "Exportação de valores"
End Sub