VBA Excel-要基于选定的单元格选择一行或多行,并复制到其他工作表中吗
请原谅我的无知,这是我第一次真正投身于vba。 我有三张床单 Master包含一个包含价格和属性的目录 plist包含一个我用教程创建的搜索按钮来过滤结果。我希望用户能够选择显示的一个或多个单元格,然后单击按钮将行复制到新工作表 “新建”是选定文件的最终目标。单击行时,行将按顺序从上到下复制 我已经寻找并尝试了一些想法,但我的无知真的阻止了我前进。希望您能提供搜索方向或任何帮助 TLDR:需要代码将选定单元格中的值复制到单独的工作表。非相邻单元格的行VBA Excel-要基于选定的单元格选择一行或多行,并复制到其他工作表中吗,excel,vba,Excel,Vba,请原谅我的无知,这是我第一次真正投身于vba。 我有三张床单 Master包含一个包含价格和属性的目录 plist包含一个我用教程创建的搜索按钮来过滤结果。我希望用户能够选择显示的一个或多个单元格,然后单击按钮将行复制到新工作表 “新建”是选定文件的最终目标。单击行时,行将按顺序从上到下复制 我已经寻找并尝试了一些想法,但我的无知真的阻止了我前进。希望您能提供搜索方向或任何帮助 TLDR:需要代码将选定单元格中的值复制到单独的工作表。非相邻单元格的行 将完整的代码复制到标准模块中,例如Modu
- 将完整的代码复制到标准模块中,例如
Module1
- 仅运行(或分配给按钮)第一个过程
。如果从VBE运行,请确保选择了工作表copyrowsofsselectedcells
(活动)。'plist'也是包含按钮的工作表plist
- 必要时,由第一方调用随附程序
- 在每个附带的过程之前,都有一个方法、属性或函数名,在下面的过程中与完成手头的任务最相关。研究(‘谷歌’)这些,以更好地理解每一个程序
Option Explicit
Sub copyRowsOfSelectedCells()
' Define Destination Worksheet Name.
Const dstName As String = "New"
' Test if Selection is a range (object).
If Not isRange(Selection) Then
GoTo ProcExit
End If
' Define Source Row Ranges.
Dim rng As Range
Set rng = CollectedRowRanges(Selection)
' Define Destination First Cell Range.
Dim cel As Range
Set cel = FirstCell(rng.Worksheet.Parent.Worksheets(dstName))
' Copy from Source Worksheet to Destination Worksheet.
copyRowsToAnotherWorksheet rng, cel
ProcExit:
End Sub
' TypeName Function
Private Function isRange(PossibleRange As Variant) _
As Boolean
If TypeName(PossibleRange) = "Range" Then
isRange = True
Else
Debug.Print "Not a range."
End If
End Function
' Range.Areas Property
Private Function CollectedRowRanges(SourceRange As Range) _
As Range
Dim bRng As Range
Dim rng As Range
Dim cel As Range
For Each rng In SourceRange.Areas
For Each cel In rng.Cells
buildRange bRng, cel.EntireRow
Next cel
Next rng
Set CollectedRowRanges = bRng
End Function
' Application.Union Method
Private Sub buildRange(ByRef BuiltRange As Range, _
AddRange As Range)
If Not BuiltRange Is Nothing Then
Set BuiltRange = Union(BuiltRange, AddRange)
Else
Set BuiltRange = AddRange
End If
End Sub
' Range.Find Method
Private Function FirstCell(Sheet As Worksheet, _
Optional ByVal ColumnIndex As Variant = "A") _
As Range
Dim cel As Range
Set cel = Sheet.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If Not cel Is Nothing Then
Set FirstCell = Sheet.Cells(cel.Row, ColumnIndex).Offset(1)
Else
Set FirstCell = Sheet.Cells(1, ColumnIndex)
End If
End Function
' Range.PasteSpecial Method
Private Sub copyRowsToAnotherWorksheet(CopyRows As Range, _
PasteCell As Range)
If Not CopyRows Is Nothing And Not PasteCell Is Nothing Then
Dim PasteRowCell As Range
Set PasteRowCell = PasteCell.Cells(1).Offset(, 1 - PasteCell.Column)
CopyRows.Copy
PasteCell.Worksheet.Activate
PasteRowCell.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
End Sub
Selection.Entirerow.Copy Sheets(“新”)。单元格(行数,1)。结束(xlUp)。偏移量(1,0)