Excel

bzzcjhmw  于 12个月前  发布在  其他
关注(0)|答案(1)|浏览(81)

使用Office 365,我尝试分阶段建立这个,因为我从来没有采取过这样的项目。我们有一个工作组,在一个每周更新的主工作簿中管理整体任务。每个任务都有过滤到更小的组执行的功能。他们希望能够复制和粘贴特定的单元格值到一个单独的工作簿,为每个小组使用Excel自动化这一点任务。工作中的扳手,是许多需要复制的单元格是合并的单元格。最初,我写了这个来捕获我想要复制的列,并在同一个工作簿中完成:

Dim NextRow As Range

    Sheets("Sheet1").Range("B1").Copy
    
    Sheets("Sheet2").Select
    Set NextRow = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0)
    NextRow.Select
    Selection.PasteSpecial (xlValues), Transpose:=False

字符串
然后,因为我想循环并找到列D中的特定文本,并且只从活动单元格行中的特定单元格复制,所以我更新为:

Dim NextRow As Range
    Dim rnge As Range
    Dim iRow As Long

    iRow = ActiveCell.Row
 
    Sheets("Sheet1").Range("B" & ActiveCell.Row).Copy
    
    Sheets("Sheet2").Select
    Set NextRow = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0)
    NextRow.Select
    Selection.PasteSpecial (xlValues), Transpose:=False


接下来,我添加了循环,这就是出错的地方。我没有得到任何错误,但我没有得到正确的信息复制,所以我错过了一些东西,我如何接近我的循环。任何帮助将不胜感激。

Dim NextRow As Range
    Dim rnge As Range
    Dim cell As Range
    Dim iRow As Long
    
    iRow = ActiveCell.Row

    Set rnge = Range("E2:E25")
    For Each cell In rnge
        If cell.Value = "GRP1" Then
    
    Sheets("Sheet1").Range("B" & ActiveCell.Row).Copy
    
    Sheets("Sheet2").Select
    Set NextRow = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0)
    NextRow.Select
    Selection.PasteSpecial (xlValues), Transpose:=False
    
    End If
        Next cell

kokeuurv

kokeuurv1#

一个人

Sub VbaLookup()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Sheets("Sheet1")
    Dim slrg As Range: Set slrg = sws.Range("E2:E25")
    
    Dim dws As Worksheet: Set dws = wb.Sheets("Sheet2")
    Dim dcell As Range: Set dcell = dws.Cells(dws.Rows.Count, "A").End(xlUp)
    
    Dim scell As Range
    
    For Each scell In slrg.Cells
        If scell.Value = "GRP1" Then
            Set dcell = dcell.Offset(1)
            dcell.Value = sws.Cells(scell.Row, "B").Value
            ' or e.g.:
            'dcell.Value = scell.EntireRow.Columns("B").Value
        End If
    Next scell

End Sub

字符串

相关问题