用于将数据复制并粘贴到另一个工作表的macros

我发现下面的代码基于一个唯一的标识符将数据从一个工作表复制和粘贴到另一个。 它也将工作表重命名为唯一标识符:)

除了公式现在显示为数字之外，它的工作状况非常好。

请有谁知道如何修改代码，以便保留实际的公式：

Dim wsAll As Worksheet Dim wsCrit As Worksheet Dim wsNew As Worksheet Dim LastRow As Long Dim LastRowCrit As Long Dim I As Long Set wsAll = Worksheets("All") ' change All to the name of the worksheet the existing data is on LastRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row Set wsCrit = Worksheets.Add ' column G has the criteria eg project ref wsAll.Range("D1:D" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True LastRowCrit = wsCrit.Range("A" & Rows.Count).End(xlUp).Row For I = 2 To LastRowCrit Set wsNew = Worksheets.Add wsNew.Name = wsCrit.Range("A2") wsAll.Rows("1:" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _ CopyToRange:=wsNew.Range("A1"), Unique:=False wsCrit.Rows(2).Delete Next I Application.DisplayAlerts = False wsCrit.Delete Application.DisplayAlerts = True End Sub 

谢谢

Answer 1

窍门是不要使用“AdvancedFilter Action：= xlFilterCopy”，因为它会将公式转换为值。 相反，使用“AdvancedFilter Action：= xlFilterInPlace”将保留该公式。 我修改了代码来反映这一点。

 Sub CopySheet() Dim wsAll As Worksheet Dim wsCrit As Worksheet Dim wsNew As Worksheet Dim LastRow As Long Dim LastRowCrit As Long Dim I As Long Set wsAll = Worksheets("All") ' change All to the name of the worksheet the existing data is on LastRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row Set wsCrit = Worksheets.Add ' column G has the criteria eg project ref wsAll.Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True LastRowCrit = wsCrit.Range("A" & Rows.Count).End(xlUp).Row For I = 2 To LastRowCrit wsAll.Copy Before:=Sheets("All") ActiveSheet.Name = wsCrit.Range("A2") Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=wsCrit.Range("A1:A2"), _ Unique:=False wsCrit.Rows(2).Delete Next I Application.DisplayAlerts = False wsCrit.Delete Application.DisplayAlerts = True End Sub