vba:将三列过滤数据复制到另一个工作表的一行

时间:2016-12-12 17:05:10

标签: vba copy-paste autofilter

我正在尝试将数据从一个工作表的三列移动到另一个工作表的一行(我需要对其进行过滤以获取此数据)。我需要将可以从源表中过滤的每个事件都拉到目标表中。

我的过滤数据存在问题,导致我的目标工作表出现问题。我试图创建一个变量(分类器),按该变量过滤,然后将过滤后的数据复制到我获得分拣变量的行中的目标表,然后移动到下一个分拣变量。到目前为止它看起来像这样:

    'Set up my loop based on id in cell from destination page
    For i = lrow To 1 Step -1                                                                   'need to double check the i and j - one should be from s and the other should be from d
        For j = 2 To lrow2 Step 1
        sorter = s.Cells(j, 1).Value
                'Sorting the source sheet
                With srange
                    .AutoFilter Field:=1, Criteria1:=sorter
                    'find the first and last row of the visible range
                    firstrow = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Row
                    lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
                        For Row = firstrow To lastrow
                            'select header row of source info
                            s.Range("c1").Select
                                'select copy the cells of the first filtered section
                                ActiveCell.Offset(1, 0).Select
                                        If Not cell.EntireRow.Hidden Then
                                            'ActiveCell.Copy d.Range("b2")
                                            'Copying and pasting first row
                                            ActiveCell.Offset(0, 1).Copy d.Cells(j, 2)
                                            ActiveCell.Offset(0, 2).Copy d.Cells(j, 3)
                                            ActiveCell.Offset(0, 3).Copy d.Cells(j, 4)
                                            'Copying and pasting second row
                                            ActiveCell.Offset(1, 1).Copy d.Cells(j, 5)
                                            ActiveCell.Offset(1, 2).Copy d.Cells(j, 6)
                                            ActiveCell.Offset(1, 3).Copy d.Cells(j, 7)
                                            'Copying and pasting third row
                                            ActiveCell.Offset(2, 1).Copy d.Cells(j, 8)
                                            ActiveCell.Offset(2, 2).Copy d.Cells(j, 9)
                                            ActiveCell.Offset(2, 3).Copy d.Cells(j, 10)
                                            'etc - I have 8 rows, but that should get me started
                                        End If
                        Next Row
                    End With
            Next j
    Next i

  firstrow = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Row

和行

   if not cell.entirerow.hidden then
当我试图绕过它们时,

都会给出错误424对象。我试图从这个问题(VBA: Select the first filtered cell then move onto the next one down)实现解决方案,但此时我很丢失。感谢您的帮助。

以下是斯科特修正的问题 - 谢谢! - 留在后面为后人

问题1是我的范围是动态的,我在这些代码行中不断收到错误1004:

    dim lrow as string
    dim lrow2 as string

    lrow = s.Range("a" & Rows.Count).End(xlUp).Row
    lrow2 = d.Range("a" & Rows.Count).End(xlUp).Row

    set name1 = s.Range(Cells(2, 1), Cells(lrow, 1))
    set name2 = d.Range(Cells(2, 1), Cells(lrow2, 1))
    set srange = s.Range(Cells(1, 1), Cells(lrow, 5))                            
    set drange = d.Range(Cells(1, 1), Cells(lrow2, 10))

我从我的另一个宏中复制了这个,但它似乎与网站上的其他答案相同(特别是这个VBA: Selecting range by variables)。当我将鼠标悬停在变量上时,它会显示我想要的数字,当我用数字替换时它仍然不起作用,因此变量不是问题。当我改为a1表示法时它工作正常(设置drange = d.range(“a1:j10”))它也可以正常工作,所以我错过了一些我看不到的简单。

1 个答案:

答案 0 :(得分:0)

我最后只是通过两个页面创建一个循环并粘贴信息。这比我想要的时间长得多,但我是手动完成的,所以速度要快得多。我知道它可以通过几种不同的方式加速,但我认为我发布了我的不良解决方案,如果我创造了一个好的解决方案,我会重新发布。我没有把这个标记解决,因为它没有回答这个问题,我仍然喜欢它的答案。这是我的循环代码:

'Loop through source
'Loop starts with setting up i for source sheet
For i = 2 To lrow2 Step 1                            'i stays on destination sheet
'Setting up the loop for the destination sheet
For j = 2 To lrow Step 1                       'j stays on source sheet

    'sorting by range in the destination sheet
    sorter = d.Cells(i, 2).Value
        'Look in cell on source page
        lcol = d.Cells(i, d.Columns.Count).End(xlToLeft).Column
        If s.Cells(j, 2).Value = sorter Then _
            s.Cells(j, 15).Copy d.Cells(i, lcol + 1)
        If s.Cells(j, 2).Value = sorter Then _
            s.Cells(j, 16).Copy d.Cells(i, lcol + 2)
        If s.Cells(j, 2).Value = sorter Then _
            s.Cells(j, 17).Copy d.Cells(i, lcol + 3)

Next j
Next i