復制合並的單元格VBA

Question

我正在嘗試將整行復制到新的工作表上，但僅復制孩子年齡大於20歲的那些行。

我尚未編寫If語句來選擇這些行，但是已經編寫了用於導入數據並填寫各個列的代碼，以便從出生日期開始20歲生日。

我的問題是導入的工作表上的列中的單元格已合並。 由於一個人可能有一個以上的孩子，因此將其合並，因此在這種情況下，與父級有關的單元格將合並。 它不會讓我復制合並的單元格。

現在，我只是想弄清楚如何復制整個工作表，以便在執行If語句之前知道如何復制合並的單元格。

到目前為止，這是我所擁有的（底部的粗體字是我嘗試復制合並的單元格的地方。ActiveSheet.Range（“ **”）。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