时间戳

首页 > 解决方案 > 从过滤表复制/粘贴可见单元格

excel - 从过滤表复制/粘贴可见单元格

问题描述

我已经编写了这段代码，它一直工作到现在。

我放了两个AutoFilter来拉某些行。如何修改代码以复制和粘贴可见行？

我试过了

Set TempRng = TempSH.Range("A1:DA" & TempSH.Range("B" & TempSH.Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy'

它复制了单元格，但随后出现错误。所需对象

Sub LoopThrough()

    Dim MyFile As String, Str As String, MyDir As String
    Dim sh As Worksheet, MasterRange As Range, TempWB As Workbook, TempSH As Worksheet, TempRng As Range
    Dim NewMasterLine As Long

    On Error GoTo ErrorHandler
    Set sh = ThisWorkbook.Worksheets("Sheet2")

    MyDir = "C:\Users\eldri\OneDrive\Desktop\New folder (2)\"
    MyFile = Dir(MyDir & "*.xls")
    ChDir MyDir

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Do While MyFile <> ""
      'opens excel
      Set TempWB = Workbooks.Open(FileName:=MyFile, UpdateLinks:=False, 

Password:=CalcPassword(MyFile))
          Set TempSH = TempWB.Worksheets(1)
          Columns(1).Insert
          Range("c2").Copy Range("A4:A10000")
          Worksheets("Data").Range("A4").AutoFilter Field:=3, Criteria1:="AMS"
          Worksheets("Data").Range("A4").AutoFilter Field:=4, Criteria1:="XNE"
          Set TempRng = TempSH.Range("A1:DA" & TempSH.Range("B" & TempSH.Rows.Count).End(xlUp).Row)

      NewMasterLine = sh.Range("B" & sh.Rows.Count).End(xlUp).Row
      If NewMasterLine > 1 Then NewMasterLine = NewMasterLine + 1
      Set MasterRange = sh.Range("A" & NewMasterLine & ":CW" & (NewMasterLine + TempRng.Rows.Count))
      MasterRange.Value = TempRng.Value
      'Debug.Print "Imported File: " & MyFile & ", Imported Range: " & TempRng.Address & ", Destination Range: " & MasterRange.Address
      TempWB.Close savechanges:=False

      MyFile = Dir()

    Loop

MsgBox ("Done")

ErrorHandler:
    If Err.Number <> 0 Then MsgBox "An error occurred." & vbNewLine & vbNewLine & "Last file that was attempted to be opened: " & MyFile & vbNewLine & vbNewLine & Err.Description
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

标签： excelvbacopy-paste

解决方案

您不能在一行中使用Setand 。.Copy

首先，您需要设置可见单元格的范围：

Set TempRng = TempSH.Range("A1:DA" & TempSH.Range("B" & TempSH.Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible)

然后你需要测试是否找到了可见的单元格，如果有，你可以复制它们：

If Not TempRng Is Nothing Then
    TempRng.Copy
    'all code that relies on the copied range `TempRng` needs to go here
Else
    MsgBox "No visible cells found!"
End If

推荐阅读