简体   繁体   English

复制合并的单元格VBA

[英]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. 我正在尝试将整行复制到新的工作表上,但仅复制孩子年龄大于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. 我尚未编写If语句来选择这些行,但是已经编写了用于导入数据并填写各个列的代码,以便从出生日期开始20岁生日。

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. 现在,我只是想弄清楚如何复制整个工作表,以便在执行If语句之前知道如何复制合并的单元格。

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 到目前为止,这是我所拥有的(底部的粗体字是我尝试复制合并的单元格的地方。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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

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