How can I use VBA Excel to filter lines and paste them into a new worksheet?

Question

I have a problem with the code behavior, this code is responsible for filter lines and paste in new worksheet that itself create

This code creates a new worksheet and saves it but doesn't paste the information the copied

Public Contratante As String

Sub Macro1()
    Dim rng As Range
    Dim WorkRng As Range
    Dim total As Long
    Dim wb As Workbook
    
    total = 1
    On Error Resume Next
    xTitleId = "Contar Preenchidas"
    
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    
    For Each rng In WorkRng
        If Not IsEmpty(rng.Value) Then
            total = total + 1
            Contratante = ActiveSheet.Range("K" & total).Value

            Workbooks.Add
            ActiveWorkbook.SaveAs Filename:="C:\Users\WMRamthun\OneDrive - META CENTRAL DE SERVICOS LTDA\Relatorios Bio\OA\Relatorio NOVO\" & Contratante & ".xlsx"

            Workbooks("OA Separa tudo.xlsm").Worksheets("Base").Range("B2").AutoFilter _
                Field:=1, _
                Criteria1:=Contratante, _
                VisibleDropDown:=False

            Workbooks("OA Separa tudo.xlsm").Worksheets("Base").Range("B2:H2", Range("B2").End(xlDown).End(xlToRight)).Copy
            Workbooks(Contratante & ".xlsx").Worksheets("Planilha1").Range("A2").PasteSpecial Paste:=xlPasteValues

            Set wb = Workbooks(Contratante & ".xlsx")
            wb.Close SaveChanges:=False
            
        End If
    Next rng
    
    MsgBox "Há " & total & " células preenchidas neste intervalo"
End Sub

I try using a sub model using call but didn't solve

1) try to [avoid using select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) in your code. 2) Always specify the sheet any range is on (ex: don't use `Range("A1")`,but use `Worksheets("Sheet1").Range("A1")` instead. Consider also specifying the workbook the sheet is in — cybernetic.nomad, Jun 01 '23 at 18:59
If you Step through the code line by like it’ll likely show you where the issue is — InjuredCoding, Jun 01 '23 at 22:40
which workbook are you trying to paste in the newly created one? — k1dr0ck, Jun 02 '23 at 03:40
Hi guys, I used @cybernetic.nomad comments and it worked partially, the value is copied correctly, but not pasted in the new worksheet Yes k1dr0ck Thanks for your help until now, I updated my code in ask — Willian Mateus Ramthun, Jun 02 '23 at 11:47

score 0 · Answer 1 · answered Jun 28 '23 at 11:11

I'm not sure which sheet is which, but here's a try. When you use copy, you have to stand/view in that sheet first.

Option Explicit

Public Contratante As String

Sub Macro1()
    Dim rng As Range
    Dim WorkRng As Range
    Dim total As Long
    Dim xTitleId As String
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Set wb1 = ActiveWorkbook
    Set ws1 = wb1.ActiveSheet 'Name of this sheet?
    Set ws2 = wb1.Worksheets("Base")
    
    total = 1
    On Error Resume Next
    xTitleId = "Contar Preenchidas"
    
    Set WorkRng = Application.InputBox("Range", xTitleId, Selection.Address, Type:=8)
    If WorkRng Is Nothing Then Exit Sub 'If cancel
    For Each rng In WorkRng
        If Not IsEmpty(rng.Value) Then
            total = total + 1
            Contratante = ws1.Range("K" & total).Value

            Workbooks.Add
            ActiveWorkbook.SaveAs Filename:="C:\Users\WMRamthun\OneDrive - META CENTRAL DE SERVICOS LTDA\Relatorios Bio\OA\Relatorio NOVO\" & Contratante & ".xlsx"
            Set wb2 = ActiveWorkbook
            Set ws3 = wb2.ActiveSheet
            
            'Strange filter
            ws2.Range("B2").AutoFilter Field:=1, Criteria1:=Contratante, VisibleDropDown:=False
            
            ws2.Activate
            ws2.Range("B2:H2", Range("B2").End(xlDown).End(xlToRight)).Copy
            ws3.Activate
            ws3.Range("A2").PasteSpecial Paste:=xlPasteValues

            wb2.Close SaveChanges:=True 'I changed this to true, so that your data is saved.
            
        End If
    Next rng
    
    MsgBox "Há " & total & " células preenchidas neste intervalo"
End Sub

How can I use VBA Excel to filter lines and paste them into a new worksheet?

1 Answers1