Copy a range to a new workbook with a condition

2020-05-01 05:00发布

database

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

Screenshot2

Any help appreciated! Thanks in advance!

1条回答
男人必须洒脱
2楼-- · 2020-05-01 05:23

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. It can be adapted to other sheets
  2. It will copy non-blanks from row 2 whether they are values and/or formulae
  3. In absence of seeing your code it copies to a new workbook

code

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
查看更多
登录 后发表回答