通过条件公式将数据从一张表复制到另一张表的宏答案

【问题标题】：Macros for copy data from one sheet to another by conditional formula通过条件公式将数据从一张表复制到另一张表的宏
【发布时间】：2016-04-11 22:13:24
【问题描述】：

我正在做一个项目，其中 excel 中有大量数据。每个数据都有行数和列数。我想按条件将这些数据移动到相应的工作表中。

Excel 工作簿：

第一个工作表名称是Shortage Report，它包含所有应该按状态移动到相应工作表的数据。

示例：

Shortage Report 列A 有城市名称：

Mumbai
Bangalore
Hyderabad
Kochi
Chennai
..... so on.

和列D 有地名。即

Mumbai - MU
Bangalore - BU 
etc.

我想使用条件公式移动数据：

如果列 A = Mumbai 和列 D = MU 则移动到工作表 MU。
如果列 A = Bangalore 和列 D = BU 则移动到工作表 BU。
如果列 A = Chennai 和列 D = CH 则移动到工作表 CH。

能否请您帮我创建 VB 脚本以将这些数据在运行中移动到相应的工作表中。

这对我有很大帮助。我花了将近 3 个小时来完成这项任务。

【问题讨论】：

你能显示你遇到问题的代码吗？

标签： vba excel

【解决方案1】：

如果你有这样的数据：

    A           B   C  
1   Mumbai      MU  Some1
2   Bangalore   BU  Some2
3   Hyderabad   HY  Some3
4   Kochi       KO  Some4
5   Chennai     CH  Some5
6   Mumbai      MU  Some6
7   Bangalore   BU  Some7
8   Chennai     CH  Some8
9   Hyderabad   HY  Some9
10  Mumbai      MU  Some10
11  Mumbai      MU  Some11
12  Chennai     CH  Some12
13  Mumbai      MU  Some13
14  Bangalore   BU  Some14
15  Hyderabad   HY  Some15
16  Bangalore   BU  Some16
17  Chennai     CH  Some17
18  Bangalore   BU  Some18
19  Kochi       KO  Some19
20  Kochi       KO  Some20
21  Bangalore   BU  Some21

在名为Shortage Report 的工作表上。然后你可以使用这个代码：

Sub qwerty()
    Dim i, Lastrow, j
    Dim SheetName As String
    Dim wb As Workbook

    Set sr = Worksheets("Shortage Report")
    Lastrow = sr.Range("B" & Rows.Count).End(xlUp).Row

    If wb Is Nothing Then Set wb = ThisWorkbook

    For j = 1 To Lastrow

        SheetName = sr.Range("B" & j).Value

        Application.DisplayAlerts = False
        On Error Resume Next

        If wb.Sheets(SheetName) Is Nothing Then
            With ThisWorkbook
                .Sheets.Add(After:=.Sheets(.Sheets.Count)).name = SheetName
            End With
        End If
        Application.DisplayAlerts = True

        sr.Range("A" & j & ":C" & j).Copy
        i = wb.Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row + 1
        wb.Sheets(SheetName).Range("A" & i & ":C" & i).PasteSpecial Paste:=xlValues

    Next j

End Sub

用如下数据制作 5 张纸：

    A       B   C  
1   Mumbai  MU  Some1
2   Mumbai  MU  Some6
3   Mumbai  MU  Some10
4   Mumbai  MU  Some11
5   Mumbai  MU  Some13

在名为MU的工作表上

    A           B   C  
1   Bangalore   BU  Some2
2   Bangalore   BU  Some7
3   Bangalore   BU  Some14
4   Bangalore   BU  Some16
5   Bangalore   BU  Some18
6   Bangalore   BU  Some21

在名为 BU 的工作表上

等等

【讨论】：