VBA 在特殊单元格更改后复制粘贴范围
VBA Copy paste a range after a special cell changes
每当 A1 中的单元格发生变化时,我都会尝试复制并粘贴范围内的值。
例如,如果 A1 中的单元格(来自公式)更改为“2016.10”,它会在 A2:A14 中查找相同的值,找到它并复制范围 B12:E12(也来自公式)并将它们粘贴为值。或者,如果 A1 更改为“2016.11”,则复制粘贴 B13:E13.
的值
有没有办法用 VBA 做到这一点?
你看起来像这样吗?
Sub SelectiveCopyPaste()
Dim WB As Workbook, Data1 As Range, Data2 As Range, RowData As Long, i As Long, FilePath As String
FilePath = "C:\Program Files\Microsoft Office\Office\RS.xlsb" 'Add your own file path
Set WB = Workbooks.Add(FilePath)
Set Data1 = Range("A2:A14") 'Change this accordingly
'Change this accordingly
Set Data2 = WB.Worksheets("RS_Summary").Range("Set the range you want to copy here")
RowData = Data1.Rows.Count
For i = 1 To RowData
If Data(i, 1) = Cells(1, 1) Then
Data2(i, 1).Copy Data1(i, 2) 'Change this too
Exit For
End If
Next
End Sub
终于,我找到了解决这个问题的方法。这是我用来帮助我的代码:
Sub PasteValues()
Dim RowData As Long, i As Long
Set Data = Range("A2:A108")
RowData = Data.Rows.Count
For i = 1 To RowData
If Data(i, 1) = Cells(1, 1) Then
Range(Cells(i + 1, 2), Cells(i + 1, 16)).Copy
Range(Cells(i + 1, 2), Cells(i + 1, 16)).PasteSpecial xlPasteValues,
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next i
Application.CutCopyMode = False
End Sub
每当 A1 中的单元格发生变化时,我都会尝试复制并粘贴范围内的值。
例如,如果 A1 中的单元格(来自公式)更改为“2016.10”,它会在 A2:A14 中查找相同的值,找到它并复制范围 B12:E12(也来自公式)并将它们粘贴为值。或者,如果 A1 更改为“2016.11”,则复制粘贴 B13:E13.
的值有没有办法用 VBA 做到这一点?
你看起来像这样吗?
Sub SelectiveCopyPaste()
Dim WB As Workbook, Data1 As Range, Data2 As Range, RowData As Long, i As Long, FilePath As String
FilePath = "C:\Program Files\Microsoft Office\Office\RS.xlsb" 'Add your own file path
Set WB = Workbooks.Add(FilePath)
Set Data1 = Range("A2:A14") 'Change this accordingly
'Change this accordingly
Set Data2 = WB.Worksheets("RS_Summary").Range("Set the range you want to copy here")
RowData = Data1.Rows.Count
For i = 1 To RowData
If Data(i, 1) = Cells(1, 1) Then
Data2(i, 1).Copy Data1(i, 2) 'Change this too
Exit For
End If
Next
End Sub
终于,我找到了解决这个问题的方法。这是我用来帮助我的代码:
Sub PasteValues()
Dim RowData As Long, i As Long
Set Data = Range("A2:A108")
RowData = Data.Rows.Count
For i = 1 To RowData
If Data(i, 1) = Cells(1, 1) Then
Range(Cells(i + 1, 2), Cells(i + 1, 16)).Copy
Range(Cells(i + 1, 2), Cells(i + 1, 16)).PasteSpecial xlPasteValues,
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next i
Application.CutCopyMode = False
End Sub