データ検証リストからコピー＆ペースト

Question

私は以下のコードを書いています。私は3つのワークシート：Dashboard,WorkingsとDataを持っています。私は企業の長いリストを持っているワークシート（Dashboard）のデータ検証リストを持っています。 リストから会社を選択し、ボタンを押してから、その会社の対応するデータ用の他の列をたくさん持っているワークシートデータの会社リストから一致させたいと考えています。選択した会社の特定のデータをワークシート（Workings）の次の使用可能な行に貼り付けることができます。ワークシート（データ）のリストには同じ会社の複数のエントリがあります。なぜここにループを追加したのですか？

このコードはエラーを出力しませんが、結果は得ていません。

誰かが私が間違って

多くの感謝を行くよどこを教えてくださいすることができます。

Sub pull_data() 

Application.Calculation = xlCalculationManual 
Application.ScreenUpdating = False 

Application.EnableCancelKey = xlDisabled 

CompanyListLocation = Worksheets("Dashboard").Cells(2, 4).Value 
'Company = Worksheets("Data").Cells(CompanyListLocation, 1).Value 

For x = 2 To 1000000 

If Worksheets("Data").Cells(x, 5).Value = CompanyListLocation Then 

Worksheets("Data").Cells(x, 5).Copy 
Worksheets("Workings").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 
Worksheets("Data").Cells(x, 14).Copy 
Worksheets("Workings").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 
Worksheets("Data").Cells(x, 15).Copy 
Worksheets("Workings").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 


End If 

Next x 

End Sub 

Answer 1

データシートのすべてのデータをワークシートのA列にコピーしようとしていますか？

以下のように試してみてください。必要に応じてそれを微調整します。

Sub CopyData() 
Dim wsCriteria As Worksheet, wsData As Worksheet, wsDest As Worksheet 
Dim CompanyListLocation 
Dim lr As Long, dlr As Long 
Application.ScreenUpdating = False 
Set wsCriteria = Sheets("Dashboard") 
Set wsData = Sheets("Data") 
Set wsDest = Sheets("Workings") 
CompanyListLocation = wsCriteria.Range("D2").Value 
lr = wsData.UsedRange.Rows.Count 
dlr = wsDest.Cells(Rows.Count, 1).End(xlUp).Row + 1 
wsData.AutoFilterMode = False 
With wsData.Rows(1) 
    .AutoFilter field:=5, Criteria1:=CompanyListLocation 
    If wsData.Range("E1:E" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then 
     wsData.Range("E2:E" & lr).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A" & Rows.Count).End(3)(2) 
     wsData.Range("N2:N" & lr).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A" & Rows.Count).End(3)(2) 
     wsData.Range("O2:O" & lr).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A" & Rows.Count).End(3)(2) 
    End If 
    .AutoFilter 
End With 
Application.ScreenUpdating = True 
End Sub 

あなたは値だけをコピーしたい場合は、これにコピーペーストコードを変更...

If wsData.Range("E1:E" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then 
    wsData.Range("E2:E" & lr).SpecialCells(xlCellTypeVisible).Copy 
    wsDest.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues 
    wsData.Range("N2:N" & lr).SpecialCells(xlCellTypeVisible).Copy 
    wsDest.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues 
    wsData.Range("O2:O" & lr).SpecialCells(xlCellTypeVisible).Copy 
    wsDest.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues 
End If