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

问题描述：

我有一张表格中的公司名称列表，并且我需要通过此数据表格中的此列表将公司名称和数据复制到工作表表。我建立了一个代码，它为每个公司提供了15次代码，我会非常高兴能找到我一个特定的循环，它将搜索特定工作表并复制我需要的数据。Excel VBA按名称列表循环显示表格的一部分

这里是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)

我建议不要使用“选择”。您在复制时是否需要格式化？如果不是，则使用'表格（“Sheet1”）。范围（“A1”）。值=表格（“Sheet2”）。范围（“A1”）。值' – Maldred

我不明白你的解决方案 –

它不是一个办法。这是编写更好的代码的提示 – jsotola

答

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

未经测试并写在手机上，抱歉格式不对。你不应该使用激活/选择，但我不想太多编辑你的原代码，如果你知道它的工作。

根据您的工作簿，用实际名称替换NameOfSheetWithCompaniesOnIt。

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

希望它有效。

它停在一行错误中：'.Range（“A2”）.End（xlDown））。Find（company.value2，，xlvalues，xlwhole，）。Activate'我将该行更改为公司而不是范围公司和它仍然没有工作 –

它的工作！我做了一些小的修改，谢谢 –

非常好，不客气，尽管我很抱歉它没有按原样工作。也许我（错误地）假设你的床单布局太多了。 – chillin

答

改变SHEETNAME和，你有公司的名单范围后试试这个，

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

你应该避免使用'.Select' – Maldred

绝对！我发布的解决方案仅用于循环显示表单名称，其他代码未触及。 –

它停止在线表（单元格）错误。激活 –

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

相关推荐