Question

我找到了以下代码，根据唯一标识符将数据从一个工作表复制并粘贴到另一个工作表。它还将工作表重命名为唯一标识符：）

除了公式现在显示为数字之外，它的效果非常好。

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

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

The trick is not to use 'AdvancedFilter Action:=xlFilterCopy' as it will convert the formula to value. Instead, use 'AdvancedFilter Action:=xlFilterInPlace' which will retain the formula. I have modified the code to reflect this.

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

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

1 个答案: