如何将2个macros组合成1

有人可能会build议如何将以下2个macros组合成1吗?

Option Explicit Sub ArchiveReminder() Dim rngToCopyFrom As Range With Worksheets("MailMerge-Reminder").Columns("A:Q") Set rngToCopyFrom = .Resize(LastColumnsRow(.Cells) - 1).Offset(1) End With PasteRangeValuesToWorksheet rngToCopyFrom, Worksheets("Archive-Reminder").Columns("A:Q") '<~~ paste values to 1st worksheet PasteRangeValuesToWorksheet rngToCopyFrom, Worksheets("AcctsDueToBeSusp").Columns("E:U") '<~~ paste values to 2nd worksheet End Sub Sub PasteRangeValuesToWorksheet(rngToCopyValuesFrom As Range, rngToPasteTo As Range) 'pastes values from the range passed as the first parameter to the range passed as the second parameter Dim lastRow As Long With rngToPasteTo lastRow = LastColumnsRow(.Cells) '<~~ get last non empty row between all columns of the range to paste to .Resize(rngToCopyValuesFrom.Rows.Count, rngToCopyValuesFrom.Columns.Count).Offset(IIf(lastRow = 1, 0, lastRow)).Value = rngToCopyValuesFrom.Value '<~~ paste values End With End Sub Function LastColumnsRow(rng As Range) As Long 'gets last non empty row between all columns of the passed range Dim maxRow As Long, lastRow As Long Dim cell As Range With rng For Each cell In .Resize(1) lastRow = .Parent.Cells(.Parent.Rows.Count, cell.Column).End(xlUp).Row If lastRow > maxRow Then maxRow = lastRow Next cell End With LastColumnsRow = maxRow End Function 

第一个macros(上面)是将​​信息从Sheet 1复制到Sheet 2&3,第二个Macro(下面)是复制到Sheet 2&3之后从Sheet 1中删除原始信息。

 Sub Clear() Range("A2:D2").Select Selection.ClearContents Rows("3:500").Select Selection.ClearContents Range("A2").Select End Sub 

非常感谢,如果有人可以提供给我一个解决scheme。

问候

你有一个子调用一个调用函数的子。 我假设你只是想clear()子成为第一个子的一部分。 只需将clear子的内容添加到第一个ArchiveReminder()子文件。

 Sub ArchiveReminder() Dim rngToCopyFrom As Range With Worksheets("MailMerge-Reminder").Columns("A:Q") Set rngToCopyFrom = .Resize(LastColumnsRow(.Cells) - 1).Offset(1) End With PasteRangeValuesToWorksheet rngToCopyFrom, Worksheets("Archive-Reminder").Columns("A:Q") '<~~ paste values to 1st worksheet PasteRangeValuesToWorksheet rngToCopyFrom, Worksheets("AcctsDueToBeSusp").Columns("E:U") '<~~ paste values to 2nd worksheet Range("A2:D2").Select Selection.ClearContents Rows("3:500").Select Selection.ClearContents Range("A2").Select End Sub 

如果你只有一个工作表,然后放置

 Call clear() 

无论你想运行清晰的子将实现这一点。

但是,如果您有多个工作表,则需要在清除单元格之前和之后在Clear()子项中指定它们。