将多个列的联合从一个表格复制到另一个表格

我写了一个代码来复制D，H，M列，并将它粘贴到一张从AC开始的全新的表格上。 我先find最后一行，之后我Union 3列范围然后select表格并粘贴它。

出于某种原因，我不明白为什么它不起作用。 我从来没有使用Union范围之前，所以不知道这是否是问题，或者是像我的循环。 帮助将不胜感激。

 Dim ws As Worksheet Dim lastRow As Integer 'for loop variables Dim transCounter As Integer Dim range1 As Range Dim range2 As Range Dim range3 As Range Dim multipleRange As Range Dim lastRow1 As Integer Dim ittercell As Integer Set ws = ActiveSheet For transCounter = 1 To 10 r.AutoFilter Field:=6, Criteria1:=transCounter.Value, Operator:=xlFilterValues With Application.ActiveSheet lastRow1 = .Cells(.Rows.Count, "AE").End(xlUp).Row End With Set range1 = Sheets("Sheet1").Range("D6:D" & lastRow1).SpecialCells(xlCellTypeVisible) Set range2 = Sheets("Sheet1").Range("H6:I" & lastRow1).SpecialCells(xlCellTypeVisible) Set range3 = Sheets("Sheet1").Range("M6:M" & lastRow1).SpecialCells(xlCellTypeVisible) Set multipleRange = Union(range1, range2, range3) multipleRange.Copy Sheets("O1 Filteration").Select 'Range("A3").Select 'Range("A3").PasteSpecial xlPasteValues ittercell = 1 Cells(3, ittercell).PasteSpecial xlPasteValues ittercell = ittercell + 6 Next transCounter 

Answer 1

你的代码有几个问题可能导致错误：

• r在你的代码中没有定义
• 使用transCounter.Value代替CStr(transCounter) （请参阅@QHarr注释）
• iterCell重置循环的每个迭代（请参阅@QHarr注释）
• ActiveSheet ，不合格Cells(...组合Cells(...和手动Select工作表使得Range限定不明确

不过，我认为使用Union ，然后Copy ，然后PasteSpecial的主要逻辑是好的，只需要一些调整。

这里有一些工作代码，你用你自己的方式更新Worksheet和Range参考。 请按照评论。

 Option Explicit Sub CopyUnionColumns() Dim wsSource As Worksheet '<-- Sheet1 in your code Dim wsTarget As Worksheet '<-- O1 Filteration in your code Dim rngFilter As Range '<-- main data range on Sheet1 Dim rngSource As Range '<-- to hold Union'd data after filtering Dim rngTarget As Range '<-- range in O1 Filteration to paste code to Dim lngLastRow As Long '<-- last row of main data Dim lngCounter As Long '<-- loop variable Dim lngPasteOffsetCol As Long '<-- offset column for pasting in the loop ' set references to source and target worksheets Set wsSource = ThisWorkbook.Worksheets("Sheet2") '<-- update for your workbook Set wsTarget = ThisWorkbook.Worksheets("Sheet3") '<-- update for your workbook ' set reference to data for filtering in source worksheet lngLastRow = wsSource.Cells(wsSource.Rows.Count, 6).End(xlUp).Row Set rngFilter = wsSource.Range("A1:F" & lngLastRow) ' initialise offset column lngPasteOffsetCol = 0 ' iterate rows For lngCounter = 1 To 10 ' filter data the data per the counter rngFilter.AutoFilter Field:=6, Criteria1:=CStr(lngCounter), Operator:=xlFilterValues ' set source range as union of columnar data per last row Set rngSource = Application.Union( _ wsSource.Range("A1:A" & lngLastRow).SpecialCells(xlCellTypeVisible), _ wsSource.Range("C1:C" & lngLastRow).SpecialCells(xlCellTypeVisible), _ wsSource.Range("E1:E" & lngLastRow).SpecialCells(xlCellTypeVisible)) ' set target range on target sheet top left cell and offset column Set rngTarget = wsTarget.Range("A1").Offset(0, lngPasteOffsetCol) ' copy source cells rngSource.Copy ' paste to target rngTarget.PasteSpecial Paste:=xlPasteAll ' increment offset lngPasteOffsetCol = lngPasteOffsetCol + 6 Next lngCounter ' cancel cut copy mode Application.CutCopyMode = False ' cancel autofilter wsSource.AutoFilterMode = False End Sub