值不会复制到新工作表

如何解决值不会复制到新工作表

最终代码是这样的

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

不幸的是，这只是关注必须复制的一部分，这些列的值在另一列中，所以我尝试切换代码

    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,_
        Unique:=True

到此为止。我使用了宏阅读器。

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

什么有效：

1. 代码使用新工作表 dws 识别零件。
2. 它在sws中过滤了C:C列，是什么意思
3. 它还可以识别sws

什么不起作用：

通过复制粘贴范围没有值被移交。

我必须通过避免重复来使用 C:C 上的高级过滤器，然后我有不想在“D:I”列中切换的数据。我唯一想要交出的是列 C 和 J。所以我尝试将列隐藏在中间，但它不起作用。

有人有想法吗？

我也用 .Delete 尝试过，但实际上并不是那么好。

我刚刚分配了 A1 来粘贴是不是有问题？

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

解决方法

复制列（唯一）

关于您的解决方案

• 您的解决方案非常棒。不过，您可能打算隐藏 D:I，这是一个小问题。
• 隐藏和过滤后，您可能会考虑取消隐藏列并移除过滤器以使源工作表恢复到初始状态。
• 我更喜欢使用带有名称的工作表而不是 ActiveSheet，但如果您知道自己在做什么，这没什么大不了的。
• 我不喜欢对整列的引用，即让 Excel (VBA) 决定应该处理哪个范围。

关于以下内容

• 我首先编写了第二个代码，该代码效率更高，但代价是无法控制要复制的列的顺序（由于 Union），因此建议使用第一个代码.
• 如有必要，您可以轻松地将源工作表 (Worksheets(sName)) 替换为 ActiveSheet。
• 假设源数据（表格（一行标题））从单元格 A1 开始。否则，您可能需要以不同的方式创建源范围引用。
• 调整（使用）常量部分中的值。

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

,

感谢@Tragmor

对于有同样问题的人来说，这可以解决它

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