Question

我想使用复制和粘贴可见单元格从一个excel复制并粘贴到另一个excel，因为我在一个设定范围之间有一个过滤表。

我想通过保存CSV来做到这一点，但显然这是不可能的。下面的代码可以工作，但它似乎没有像我一样复制粘贴可见细胞/过滤细胞。

提前致谢。或者，如果还有另一种推荐的方法可以将过滤后的表格转换为CSV，我很乐意听到。欢呼声。

Sub Macro2()
'
' Macro2 Macro
'

'

 Dim lastRow As Long
Dim ws As Worksheet, tbl As ListObject
Set ws = Sheets("Sheet1")
Set tbl = ws.ListObjects("Table1")

With tbl.ListColumns(3).Range
    lastRow = .Find(What:="*", _
                After:=.Cells(1), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row
End With


Sheet1.Range("A2").SpecialCells(xlCellTypeVisible).Copy _
        Destination:=Range("A2")


    ActiveWorkbook.SaveAs Filename:="C:\Users\teaz\Videos\CSV", FileFormat:= _
        xlCSV, CreateBackup:=False

 ActiveWorkbook.SaveCopyAs Filename:="C:\Users\teaz\Videos" & Test1Str & " " & TestStr & " " & ActiveWorkbook.Name

    Application.ActiveWindow.Close SaveChanges:=False
ActiveWorkbook.Close SaveChanges:=False




End Sub

Answer 1

Copy all previously filtered data from all worksheets to another

Sub CopyFilteredDataToNewWorkbook()

    Dim newBook As Excel.Workbook
    Dim rng As Excel.Range
    Dim sht As Excel.Worksheet
    Dim rowoffsetcount As Long
    Dim newsht As Excel.Worksheet

    Set newBook = Workbooks.Add

    ' ThisWorkbook.Worksheets is the same as the Sheets or Worksheets object, but more explicit
    For Each sht In ThisWorkbook.Worksheets

        ' Get the used rows and columns
        Set rng = sht.UsedRange

        ' Offset the range so it starts at row 15
        rowoffsetcount = 15 - rng.Row
        Set rng = rng.Offset(rowoffsetcount)

        ' Check there will be something to copy
        If (rng.Rows.Count - rowoffsetcount > 0) Then

            ' Reduce the number of rows in the range so it ends at the same row
            Set rng = rng.Resize(rng.Rows.Count - rowoffsetcount)

            ' Check that there is a sheet we can copy it to
            On Error Resume Next
            Set newsht = Nothing
            Set newsht = newBook.Worksheets(sht.Index)
            On Error GoTo 0

            ' We have run out of sheets, add another at the end
            If (newsht Is Nothing) Then
                Set newsht = newBook.Sheets.Add(, newBook.Worksheets(newBook.Worksheets.Count))
            End If

            ' Give it the same name
            newsht.Name = sht.Name

            ' Get the range of visible (i.e. unfiltered) rows
            ' (can't do this before the range resize as that doesn't work on disjoint ranges)
            Set rng = rng.SpecialCells(xlCellTypeVisible)

            ' Paste the visible data into the new sheet
            rng.Copy newsht.Range("A1")

        End If

    Next

End Sub

Answer 2

我认为这一行是你的问题：

'/* you only worked on Range("A2") */
Sheet1.Range("A2").SpecialCells(xlCellTypeVisible).Copy

您应该访问tbl对象，例如：

'/* this will give you the entire filtered table body */
tbl.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy

同样，您可以使用：

Sheet1.Range("YourTableName").SpecialCells(xlCellTypeVisible).Copy

最后，避免使用Active前缀的所有对象（例如ActiveWorkbook，ActiveWindow）。您已经知道如何分配变量，然后保持一致。

如何将可见单元格（FILTERED TABLE CELLS）复制并粘贴到CSV

2 个答案: