Excel VBA按名称列表循环浏览表单部分

我有一个表中的公司名称列表，我需要通过数据表中的这个列表去公司名称表和复制数据表。 我build立了一个代码，它为每个公司做了15次，我会很高兴能find我一个特定的循环，将search特定的工作表并复制我需要的数据。

这里是每个表格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) 

Answer 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 

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

根据您的工作簿，用实际名称replaceNameOfSheetWithCompaniesOnIt。

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

希望它的作品。

Answer 2

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

 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