简体   繁体   中英

Copy merged cells VBA

I am trying to copy entire rows onto a new worksheet, but only copy those rows where a childs age is above 20.

I have not yet written the If statements to select these rows, but have written code to import the data and fill in various columns in order to get the 20th birthday from the birth date.

My problem is that the cells in the columns that are on the imported worksheet are merged. This is merged because one person may have more than one child, so in this case, the cells regarding the parent are merged. It won't let me copy the merged cells.

For now I'm just trying to work out how to copy the entire sheet just so I know how to copy merged cells, before doing the If statement.

This is what I have so far (bold bit at bottom is where I'm trying to copy merged cells. I'm getting an error on the line with 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
Range("A5").Copy
sheet2.Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM