Question

我正在尝试将整行复制到新工作表中，但只复制那些孩子年龄超过20岁的行。

我还没有编写If语句来选择这些行，但是已编写代码来导入数据并填写各个列以便从出生日期开始20岁生日。

我的问题是导入的工作表中的列中的单元格是合并的。这是合并的，因为一个人可能有一个以上的孩子，所以在这种情况下，关于父母的单元格被合并。它不会让我复制合并的单元格。

现在我只是想弄清楚如何复制整张表，这样我就知道如何在执行If语句之前复制合并的单元格。

这就是我到目前为止（粗略位置是我尝试复制合并单元格的地方。我在ActiveSheet.Range上遇到错误（＆＃34; ** ＆＃34;。）MergeArea.Copy

Option Explicit

Sub ImportActiveList()
Dim FileName As String
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim ActiveListWB As Workbook

    Set WS2 = ActiveWorkbook.Sheets("Sheet1")
    FileName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*),*.xls*", _
                                               Title:="Select Active List to Import", _
                                               MultiSelect:=False)

    If FileName = "False" Then
            Exit Sub
        Else
            Set ActiveListWB = Workbooks.Open(FileName)
    End If

    Set WS1 = ActiveListWB.Sheets("Page1-1")

    WS1.UsedRange.Copy WS2.Range("A1")

    ActiveWorkbook.Close False

End Sub


Sub CalculateBirthday()

    Dim lastrow As Long
    lastrow = Range("X" & Rows.Count).End(xlUp).Row

    ActiveSheet.Range("A5:AA291").AutoFilter
    ActiveSheet.Range("$A$5:$AA$291").AutoFilter Field:=24, Criteria1:="Child"

    Range("AB5") = "Today's Age Year/Month"
    Range("AB7:AB" & lastrow).Formula = "=DATEDIF(RC[-2],TODAY(),""Y"") & "" Years, "" & DATEDIF(RC[-2],TODAY(),""YM"") & "" Months """
    Columns("AB:AB").EntireColumn.AutoFit

    Range("AC5") = "Today's Age Year Only"
    Range("AC7:AC" & lastrow).Formula = "=DATEDIF(RC[-3],TODAY(),""Y"")"
    Columns("AC:AC").EntireColumn.AutoFit

    Range("AD5") = "Child 20th Birthday"
    Range("AD7:AD" & lastrow).Formula = "=DATE(YEAR(R[-1]C[-4])+20, MONTH(R[-1]C[-4]),DAY(R[-1]C[-4]))"
    Columns("AD:AD").EntireColumn.AutoFit


    ActiveSheet.Range("A5:AA291").MergeArea.Copy    'copies the merged cells 
    Sheet2.Range("A1").PasteValues       ' pastes what was copied into A1 on Sheet 2 and any merged cells**

End Sub

Answer 1

Range("A5").Copy
sheet2.Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

复制合并的单元格VBA

1 个答案: