從數據驗證列表中複製並粘貼

我寫下了下面的代碼。我有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

來源

2017-06-02 Ollie

'工作表（「數據」）。Cells'只是細胞我相信將是「儀表板」 –

你是對的，謝謝，錯過了，但仍然沒有運氣與代碼 – Ollie

相同的'rows.count'你可以說'工作表（「工作」）。範圍（「A1」）。值=工作表（「數據「）.range（」a1「）.value'，不需要粘貼特殊值。 –

您是否試圖複製工作表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

來源

2017-06-02 16:20:39 sktneer

令人驚歎，謝謝你這麼多 – Ollie

@Ollie不客氣！ – sktneer

從數據驗證列表中複製並粘貼

回答

相關問題