使用VBA生成新工作表,使用一个工作表中的值并导出为CSV

时间:2016-07-19 08:29:58

标签: excel vba excel-vba

我想使用VBA宏来拉取两列数据,并放在另一张表上,这将基于第一列。更简单的例子......

Set A   Table 1
Set A   Table 2
Set A   Table 3
Set A   Table 4
Set B   Table 5
Set B   Table 6

因此,这将生成两个工作表,其中包含Set A with set A table list,另一个包含set B with set B table list ..然后我将所有这些工作表导出为CSV ...我当前代码(下面)在A列中找不到重复的值,然后移动到新的工作表,我现在希望这样找到B列的值。

Dim wsYes As Worksheet
Set wsYes = Worksheets("YES")

With wsYes

    Dim myRange As Range
    Set myRange = .Range("A2", .Range("A2").End(xlDown))

    myRange.Copy .Cells(1, .Columns.Count) 'copy to far right column
    .Cells(1, .Columns.Count).Resize(myRange.Rows.Count, 1).RemoveDuplicates 1, xlNo

    Set myRange = .Range(.Cells(1, .Columns.Count), .Cells(1, .Columns.Count).End(xlDown))

    For Each MyCell In myRange

        Dim sName As String
        sName = UCase(MyCell.Value)

        Dim wsNew As Worksheet
        Set wsNew = Sheets.Add
        With wsNew
            .Name = sName
            .Range("A1").Value = "Source"
            .Range("A1").Font.Bold = True
            .Range("A2").Value = sName
            .Range("B1").Value = "Table Name"



        End With

    Next MyCell

    myRange.Clear

End With

结果是这样的

Source worksheet
Column A  Column B
Set A     Table 1
Set A     Table 2
Set A     Table 3 
Set B     Table 4
Set B     Table 5
Set B     Table 6 

Generated Worksheet 1
Column A  Column B
Set A     Table 1
          Table 2
          Table 3 
          ect....

Generated Worksheet 2
Column A  Column B
Set B     Table 4
          Table 5
          Table 6 
          ect....

在一个工作簿中,没有外部工作表。

提前致谢,如果您需要任何其他信息,请询问:)

1 个答案:

答案 0 :(得分:0)

尝试使用以下代码

Sub test()
    Dim lastrow, aincre, bincre, i As Long
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    aincre = 2
    bincre = 2
    Sheets("Sheet1").Select
    For i = 2 To lastrow
        If Cells(i, 1) = "Set A" Then
            Sheets("Sheet2").Range("A" & aincre) = "Set A"
            Sheets("Sheet2").Range("B" & aincre) = Cells(i, 2)
            aincre = aincre + 1
        ElseIf Cells(i, 1) = "Set B" Then
            Sheets("Sheet3").Range("A" & bincre) = "Set B"
            Sheets("Sheet3").Range("B" & bincre) = Cells(i, 2)
              bincre = bincre + 1
        End If
    Next i
End Sub