复制只能从一张纸上看到另一张（中间有空白）

道歉编辑。我有下面这段代码，它将一行数据从1张复制到另一张（中间有空白）。代码工作正常，但我希望它只复制表1中的可见字段（已应用过滤器）。复制只能从一张纸上看到另一张（中间有空白）

这无论复制整个列u应用（过滤器应用于我列10和38）的过滤器

With Worksheets("Sheet1") 

Set SrcRng = .Range(.Cells(1, "U"), .Cells(.Rows.Count, "U").End(xlUp)) 
End With 
Worksheets("Sheet2").range("I1").Resize(SrcRng.Rows.Count, 1).Value = SrcRng.Value'

请帮

来源

2017-07-31 Sona123

不知道如果你有过滤器，那么你应该首先添加'.Range（“$ A：$ U”）。AutoFilter'或者你使用了哪些列。这篇文章可能会指出你在一个方向https://stackoverflow.com/questions/13934821/vba-for-filtering-columns。 atm它看起来像你试图过滤一列中的字段'“U”' – krib

你将你的过滤器范围设置为一个sinlge列“U”，你如何期望在第8,10和39列上运行过滤器？你有一个39列的范围？ –

尝试：

Sub CopyVisible() 
Dim ws As Worksheet, ws2 As Worksheet 
Dim SrcRange As Range, CpyRng As Range 
Dim LRow As Long 

Set ws = Worksheets("Sheet1") 
Set ws2 = Worksheets("Sheet2") 

If ws.AutoFilterMode Then ws.AutoFilter.ShowAllData 'Removes Previous Filters 

With ws 
    LRow = .Cells(.Rows.Count, 8).End(xlUp).Row 'Check Col "H" for last data 
    Set SrcRng = .Range(.Cells(1, 1), .Cells(LRow, 39)) 'Range with Data 
     With SrcRng 
      .AutoFilter Field:=39, Criteria1:="Blue" 
      .AutoFilter Field:=8, Criteria1:="Pass" 
      .AutoFilter Field:=10, Criteria1:="<>" 
     End With 
    For i = 1 To LRow 'Loop through all Rows 
     If Not .Cells(i, 1).EntireRow.Hidden Then 'Checks if Row is Hidden 
      If CpyRng Is Nothing Then 
       Set CpyRng = .Range("U" & i) 
      Else 
       Set CpyRng = Union(CpyRng, .Range("U" & i)) 
      End If 
     End If 
    Next i 
End With 
ws.AutoFilter.ShowAllData 'Remove Filters 
CpyRng.Copy ws2.Range("I1") 'Copy and Paste 
End Sub

将适用过滤到1到39的所有列，并使用所需标准进行过滤。用Col U中的所有可见行创建范围，并将它们粘贴到Sheet2中，并粘贴到Col I中。

来源

2017-07-31 08:12:00 UGP

非常感谢，但我希望只有表格1中的列U被复制到表格2中的列I中才有可能？ – Sona123

@ Sona123我更新了它:) – UGP

这工作完美。谢谢:) – Sona123

复制只能从一张纸上看到另一张（中间有空白）

回答

相关问题