我在表格中列出了公司名称,我需要通过数据表中的此列表,将带有公司名称的表格复制到表格中。我为每个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)
答案 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]替换为实际的表名和列名。
希望它有效。