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

从数据验证列表中复制并粘贴

1 个答案: