Values are not copied to new Sheet

Question

The final code is this

Sub Unique_Values_Worksheet_Variables()

'1 Code + Sub splitByChars
    
    Const Chars As Long = 4
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim sws As Worksheet: Set sws = wb.Worksheets("export")
    Dim dws As Worksheet:
    Set dws = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    
    sws.Range("C:C").AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=dws.Range("A:A"), _
        Unique:=True
          
    dws.Columns("A:J").EntireColumn.AutoFit
    Dim rng As Range:
    Set rng = dws.Range("A1:B1", dws.Cells(dws.Rows.Count, 1).End(xlUp))
    rng.Borders(xlDiagonalDown).LineStyle = xlNone
    rng.HorizontalAlignment = xlCenter

Unfortunately this was just focused on one part which has to be copied, the values for these columns were in another column so i try to switch the code

    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim sws As Worksheet: Set sws = wb.Worksheets("export")
    Dim dws As Worksheet:
    Set dws = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))

    sws.Range("C:C").AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=dws.Range("A:A"), _
        Unique:=True

to this. I used the macro reader for it.

Sub Test()
'
' Test Makro
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim sws As Worksheet: Set sws = wb.ActiveSheet
    Dim dws As Worksheet:
    Set dws = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    
    Application.ScreenUpdating = False
    
    sws.Columns("C:C").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Columns("D:H").EntireColumn.Hidden = True
    Columns("C:J").Select
    Selection.Copy Destination:=dws.Range("A1")
   
    
End Sub

what works:

1. the code recognizes the part with the new worksheet dws.
2. it filters in sws the column C:C, what means
3. it also recognizes sws

what does not work:

by copy paste the range no values are hand over.

I have to use the advanced filter on C:C by avoiding duplicates, then i have data which i do not want to handover in column "D:I". The only thing what i want to hand over is column C & J. So i tried it with hiding the columns in between but it does not work.

Has anybody an idea?

i also tried it with .Delete what actually would be not that nice.

Is it a problem that i just assigned A1 for pasting it?

 Selection.Copy Destination:=dws.Range("A1")

Answer 1

Copy Columns (Unique)

About Your Solution

• Your solution is pretty cool. You probably meant to hide D:I though, which is a minor issue.
• After hiding and filtering you might consider unhiding the columns and removing the filter to bring the source worksheet to the initial state.
• I prefer using a worksheet with a name instead of ActiveSheet, but it's no big deal if you know what you're doing.
• I don't like the references to the whole columns i.e. letting Excel (VBA) decide which range should be processed.

About the following

• I first wrote the second code which is kind of more efficient but comes with the cost of not being able to control the order of the columns (due to Union) to be copied, hence the first code is recommended.
• You can easily replace the source worksheet (Worksheets(sName)) with ActiveSheet if necessary.
• It is assumed that the source data (table (one row of headers)) starts in cell A1. Otherwise, you may need to create the source range reference in a different way.
• Adjust (play with) the values in the constants section.

Option Explicit

Sub copyColumnsUnique()
    
    ' Source
    Const sName As String = "Sheet1"
    Const sUniqueColumn As String = "C"
    Const sCopyColumnsList As String = "C,J" ' exact order of the columns
    ' Destination (new worksheet)
    Const dFirst As String = "A1"
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim sCopyColumns() As String: sCopyColumns = Split(sCopyColumnsList, ",")
    Dim dCell As Range: Set dCell = wb.Worksheets _
        .Add(After:=wb.Sheets(wb.Sheets.Count)).Range(dFirst)
    
    Application.ScreenUpdating = False
    
    Dim srg As Range
    With wb.Worksheets(sName).Range("A1").CurrentRegion
        .Columns(sUniqueColumn).AdvancedFilter xlFilterInPlace, , , True
        Dim n As Long
        For n = 0 To UBound(sCopyColumns)
            .Columns(sCopyColumns(n)).Copy dCell
            Set dCell = dCell.Offset(, 1)
        Next n
        .Parent.ShowAllData
    End With
    
    Application.ScreenUpdating = True
    
End Sub

Sub copyColumnsUniqueAsc()
    
    ' Source
    Const sName As String = "Sheet1"
    Const sUniqueColumn As String = "C"
    Const sCopyColumnsList As String = "C,J" ' forced ascending order of columns
    ' Destination (new worksheet)
    Const dFirst As String = "A1"
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim sCopyColumns() As String: sCopyColumns = Split(sCopyColumnsList, ",")
    
    Application.ScreenUpdating = False
    
    Dim srg As Range
    With wb.Worksheets(sName).Range("A1").CurrentRegion
        .Columns(sUniqueColumn).AdvancedFilter xlFilterInPlace, , , True
        ' Using 'Union' will force the resulting columns be in ascending order.
        ' If 'sCopyColumnsList' is "C,J,D", the order will be "C,D,J".
        Dim n As Long
        For n = 0 To UBound(sCopyColumns)
            If srg Is Nothing Then
                Set srg = .Columns(sCopyColumns(n))
            Else
                Set srg = Union(srg, .Columns(sCopyColumns(n)))
            End If
        Next n
    End With
    
    srg.Copy wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Range(dFirst)
    srg.Parent.ShowAllData
      
    Application.ScreenUpdating = True
    
End Sub

Answer 2

Thanks to @Tragmor

for everyone who has same kind of problems, this could solve it

Sub Test()
'
' Test Makro
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim sws As Worksheet: Set sws = wb.ActiveSheet
    Dim dws As Worksheet:
    Set dws = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    
    Application.ScreenUpdating = False
    
    With sws

    .Columns("C:C").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    .Columns("D:H").EntireColumn.Hidden = True
    .Columns("C:J").Copy Destination:=dws.Range("A1")
    
    End With
   
    
End Sub