[英]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.