Excel VBA按名称列表循环显示部分表格

时间:2017-10-22 05:07:48

标签: excel vba excel-vba

我在表格中列出了公司名称,我需要通过数据表中的此列表,将带有公司名称的表格复制到表格中。我为每个comapny构建了一个15次代码,我会很高兴找到一个可以搜索特定工作表并复制我需要的数据的循环。

以下是每张表中15个代码中的2个的示例:

Sheets("Comapny1").Activate
Range("H2").End(xlDown).Select
Range(Selection, Selection.End(xlToRight)).Copy
Sheets("Data").Activate
Range("A2", Range("A2").End(xlDown)).Find("Comapny1").Activate
ActiveCell.Offset(0, 1).PasteSpecial (xlPasteValues)

Sheets("Comapny2").Activate
Range("H2").End(xlDown).Select
Range(Selection, Selection.End(xlToRight)).Copy
Sheets("Data").Activate
Range("A2", Range("A2").End(xlDown)).Find("Comapny2").Activate
ActiveCell.Offset(0, 1).PasteSpecial (xlPasteValues)

2 个答案:

答案 0 :(得分:1)

在更改工作表名称和公司列表所在的范围后尝试此操作

Sub test()

    Dim companies As Range
    Dim cell As Range

    Set companies = Sheets("CompnayNamesSheet").Range("A1:A10")

    For Each cell In companies

        Sheets(cell.Value).Activate
        Range("H2").End(xlDown).Select
        Range(Selection, Selection.End(xlToRight)).Copy

        Sheets("Data").Activate
        Range("A2", Range("A2").End(xlDown)).Find(cell.Value).Activate
        ActiveCell.Offset(0, 1).PasteSpecial (xlPasteValues)

    Next cell

End Sub

答案 1 :(得分:1)

Option explicit

Sub LoopThroughCompanies()

    Dim Company as Range
    Dim Companies as Range

    Set Companies = Thisworkbook.Worksheets(NameOfSheetWithCompaniesOnIt).range(TableName[ColumnName])

    For each Company in Companies
        With thisworbook.worksheets(company.value2)
            .activate
            .Range("H2").End(xlDown).Select
            .Range(Selection, Selection.End(xlToRight)).Copy
        End with
        With thisworkbook.workSheets("Data")
            .Activate
            .Range("A2", .Range("A2").End(xlDown)).Find(company.value2,,xlvalues,xlwhole,).Activate
            ActiveCell.Offset(0, 1).PasteSpecial (xlPasteValues)
        End with
    Next Company

End sub

未经测试并写在手机上,抱歉格式不正确。您不应该使用activate / select,但如果您知道它正在工作,我不想太多地编辑您的原始代码。

根据您的工作簿将NameOfSheetWithCompaniesOnIt替换为实际名称。

根据您的工作簿,将TableName [ColumnName]替换为实际的表名和列名。

希望它有效。