将范围复制到具有条件的新工作簿 [英] Copy a range to a new workbook with a condition

问题描述

嗨所有！
我一直在尝试使vba代码用于以下目的：将工作簿的范围（A1：F2上方的屏幕截图）复制到新的工作簿。
我已经设法实现了这一点。还有一个额外的条件，我想添加到vba代码。 vba代码应该仅复制第2行中填充值的列。
因此，查看截图中的示例，这意味着通过运行vba代码，我将保存到新的工作簿范围A1：A2，C1：C2，E1：E2。
新的担忧看起来像第二个截图

Hi all! I have been trying to make vba code for the following purpose: copy a range of a workbook (screenshot above A1:F2) to a new workbook. I have managed to achieve this. There is one additional criteria which i would like to add to the vba code. The vba code should only copy those columns where row 2 has a value filled in. Thus, looking at the example in the screenshot, this would mean that by running the vba code, I would save to a new workbook the ranges A1:A2, C1:C2, E1:E2. The new worbook would look like the second screenshot

任何帮助赞赏！感谢提前！

Any help appreciated! Thanks in advance!

推荐答案

一个非常有用的忽略空白的方式 - 没有循环 - 是使用 SpecialCells 。下面的代码可能比您的问题需要的时间要长一些，但是这样写就可以使得

A very useful way of ignoring blanks - without looping - is to use SpecialCells. The code below is probably a little lengthier than needed for your question but it is written so that

1. 它可以适应其他工作表
2. 
   
3. 它将从第2行复制非空白，无论它们是值和/或公式。


4. 如果没有看到您的代码，它将复制到新的工作簿

代码

Sub CopyEm()
Dim WB As Workbook
Dim ws As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Set ws = Sheets(1)
On Error Resume Next
Set rng1 = ws.Rows(2).SpecialCells(xlConstants)
Set rng2 = ws.Rows(2).SpecialCells(xlFormulas)
If rng1 Is Nothing Then
Set rng3 = rng2
ElseIf rng2 Is Nothing Then
Set rng3 = rng1
Else
Set rng3 = Union(rng1, rng2)
End If
If rng3 Is Nothing Then Exit Sub
On Error GoTo 0
Set WB = Workbooks.Add
rng3.Offset(-1, 0).Copy WB.Sheets(1).[a1]
rng3.Copy WB.Sheets(1).[a2]
End Sub

这篇关于将范围复制到具有条件的新工作簿的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！