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

问题描述

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

I found the below code to copy and paste data from one worksheet to another based on a unique identifier. It also renames the worksheet as the unique identifier :)

它的工作原理很好，现在公式中显示为数字。

It works really well apart from that formulas now appear as numbers.

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

Please does anyone know how to amend the code so that the actual formulas are kept :-

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

谢谢

推荐答案

诀窍不是使用'AdvancedFilter Action：= xlFilterCopy'，因为它会将公式转换为值。而是使用'AdvancedFilter Action：= xlFilterInPlace'，它将保留公式。我已经修改了代码来反映这一点。

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

这篇关于用于复制和粘贴数据到另一个工作表的宏的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！