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)

來源

2017-10-22 Rafael Osipov

我建議不要使用「選擇」。您在複製時是否需要格式化？如果不是，則使用'表格（「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]替換爲實際的表名稱和列名稱。

希望它有效。

來源

2017-10-22 05:40:49 chillin

它停在一行錯誤中：'.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

來源

2017-10-22 05:40:38

你應該避免使用'.Select' – Maldred

絕對！我發佈的解決方案僅用於循環顯示錶單名稱，其他代碼未觸及。 –

它停止在線表（單元格）錯誤。激活 –

Excel VBA按名稱列表循環顯示錶格的一部分

回答

相關問題