使用vba从表复制和粘贴

时间:2017-10-11 17:21:23

标签: excel vba excel-vba

MS Excel 2016 VBA

除非过滤表,否则以下代码效果很好。如何在不撤消过滤的情况下解决这个问题?

我需要每天复制新列并将其粘贴到旧列,以便我们跟踪每日进度。

我有额外的代码来解决,但我不喜欢这个想法。

建议

Sub Table_Move()

    Dim tbl As ListObject
    Dim N As String
    Dim O As String

    Call Clear

    N = "New"
    O = "Old"

    Set tbl = ActiveSheet.ListObjects("Table1")

    tbl.ListColumns(N).DataBodyRange.Copy
    tbl.ListColumns(O).DataBodyRange.PasteSpecial xlPasteValues


End Sub

2 个答案:

答案 0 :(得分:1)

Sub Table_Move()

    Dim N As String
    Dim O As String

    Call Clear

    N = "New"
    O = "Old"

    Range("Table1[" & N & "]").Copy
    Range("Table1[" & O & "]").PasteSpecial xlPasteValues


End Sub

更新

仅处理可见细胞

Sub Table_Move()

    Dim N As String
    Dim O As String
    Dim Rng As Range
    Dim rw As Range

    Call Clear

    N = "New"
    O = "Old"

    For Each rw In Range("Table1[" & N & "]").Cells

        If rw.EntireRow.Hidden = False Then
            If Rng Is Nothing Then Set Rng = rw
            Set Rng = Union(rw, Rng)
        End If

    Next rw

    Rng.Copy

    Range("Table1[" & O & "]").PasteSpecial xlPasteValues    

End Sub

另外

Sub Table_Move()

    Dim N As String
    Dim O As String

    Call Clear

    N = "New"
    O = "Old"

    Range("Table1[" & N & "]").SpecialCells (xlCellTypeVisible).Copy
    Range("Table1[" & O & "]").PasteSpecial xlPasteValues


End Sub

答案 1 :(得分:0)

这段代码将复制并粘贴数据范围中的每一行,即使过滤器在

上也是如此
Sub Move()
Dim rowcount As Integer, currentRow As Integer
Dim sourceCol  As Integer, TargetCol As Integer

sourceCol = 14 ' Its N Column
TargetCol = 15 ' Its O Column
rowcount = Cells(Rows.Count, sourceCol).End(xlUp).Row 'counts the rows with data
For currentRow = 1 To rowcount
    Range("O" & currentRow).Value = Range("N" & currentRow).Value 'Copy from N to O
Next

End Sub