繁体   English   中英

使用 VBA excel 中的变量引用将数据从一张纸复制到另一张纸

[英]Copy data from one sheet to another using variable references in VBA excel

我正在尝试将 H 列中的数据复制到新工作表中。 我希望新工作表中的复制粘贴位置取决于从 C2 的下拉菜单和 E2 的下拉菜单中选择的选项。 新工作表有一个表格,列中包含 C2 和 E2 中的选项。 我需要代码来查看 C2 和 E2 中的内容,在表格中找到该位置并复制粘贴。

我可以让它引用类型并从中复制它,但是当我希望它同时引用类型和月份时。 它死了。

Sub COPY_TRANSPOSE()
'this program looks for type and month in sheet Data
'If the type and month are found, copies H6:H1000 in sheet Data and paste it to sheet table

Dim rng_source As Range
Dim rng_dest As Range
Dim cell As Range
Const Type_Cell = "A1" 'Cell that refers to the type
Cont Month = "E2" 'month


Set rng_source = ThisWorkbook.Sheets("Data").Range("H6:H1000")
Set rng_dest = ThisWorkbook.Sheets("Table").Range("A2:A1000")
Set rng_dest2 = ThisWorkbook.Sheets("Table").Range("C2:C1000")
Set cell = rng_dest.Find(what:=ThisWorkbook.Sheets("Table").Range(Type_Cell).Value, LookIn:=xlValues, lookat:=xlWhole)
Set cell2 = rng_dest2.Find(what:=ThisWorkbook.Sheets("table").Range(Month).Value, LookIn:=xlValues, lookat:=xlWhole)

If Not cell And cell2 Is Nothing Then

rng_source.copy

Sheets("table").Range(cell.Offset(0, 1), cell.Offset(0, 7)).PasteSpecial Transpose:=True

Else
MsgBox ("error")
End If

End Sub

请试试这个

Option Explicit
Sub test()
  Dim wsIn As Worksheet: Set wsIn = ThisWorkbook.Worksheets("Sheet1")
  Dim wsOut As Worksheet: Set wsOut = ThisWorkbook.Worksheets("Sheet2")
  
  'following your range hard coding here
  Dim rOut As Range: Set rOut = wsOut.Range("a2:c1000")
  
  'strip values
  Dim s_fruit As String: s_fruit = wsIn.Range("c2").Value
  Dim s_month As String: s_month = wsIn.Range("e2").Value
  Dim d_value As Double: d_value = wsIn.Range("h4").Value
  
  'filter to get row of interest
  rOut.AutoFilter field:=1, Criteria1:=s_fruit, Operator:=xlFilterValues
  rOut.AutoFilter field:=3, Criteria1:=s_month, Operator:=xlFilterValues

  ' only attempt to set value if we get strictly 1 row filtered
  If rOut.SpecialCells(xlCellTypeVisible).Rows.Count = 1 Then
      rOut.Cells(1, 1).End(xlDown).Offset(0, 3).Value = d_value
  End If
  
  'remove filter
  rOut.AutoFilter

End Sub

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM