如何将两个不同工作表中的列复制到一张工作表中答案

【问题标题】：How to copy columns from two different sheets into one sheet如何将两个不同工作表中的列复制到一张工作表中
【发布时间】：2017-06-04 23:21:08
【问题描述】：

我正在处理一项任务，我需要将 Sheet1 和 Sheet2 中的特定列复制到 Sheet3 中。

应该复制数据的工作表从第 14 行开始。Sheet1 和 Sheet2 中的数据的长度也不同。

我已经找到了一种将数据从 Sheet1 复制到 sheet3 的方法（通过研究）。问题是当我尝试将数据从 sheet2 复制到 sheet3 时，我的代码只是覆盖了从 sheet1 复制的 sheet3 中的数据。

我希望我的代码将数据从 sheet2 复制到 sheet3，并将其直接放在从 sheet1 复制的数据下方。而且由于 sheet1 中的数据可能会有所不同（它可能包含 0 行或 100 行）。

Sub copyDataFromTwoSheetsIntoOneSheet()

With Sheets("Sheet1")
.AutoFilterMode = False
LR = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("B14:O" & LR).AutoFilter Field:=14, Criteria1:="<>"

If LR > 1 Then
    .Range("B14:B" & LR).Copy
    Sheets("Sheet3").Range("B14").PasteSpecial xlPasteValues

    .Range("C14:C" & LR).Copy
    Sheets("Sheet3").Range("C14").PasteSpecial xlPasteValues

    .Range("D14:D" & LR).Copy
    Sheets("Sheet3").Range("D14").PasteSpecial xlPasteValues

    .Range("E14:E" & LR).Copy
    Sheets("Sheet3").Range("E14").PasteSpecial xlPasteValues

    .Range("F14:F" & LR).Copy
    Sheets("Sheet3").Range("F14").PasteSpecial xlPasteValues

    .Range("G14:G" & LR).Copy
    Sheets("Sheet3").Range("G14").PasteSpecial xlPasteValues

    .Range("H14:H" & LR).Copy
    Sheets("Sheet3").Range("H14").PasteSpecial xlPasteValues

    .Range("I14:I" & LR).Copy
    Sheets("Sheet3").Range("I14").PasteSpecial xlPasteValues

    .Range("J14:J" & LR).Copy
    Sheets("Sheet3").Range("J14").PasteSpecial xlPasteValues

    .Range("O14:O" & LR).Copy
    Sheets("Sheet3").Range("N14").PasteSpecial xlPasteValues

End If
.AutoFilterMode = False
End With

With Sheets("Sheet2")
.AutoFilterMode = False
LR = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("B14:M" & LR).AutoFilter Field:=12, Criteria1:="<>"


If LR > 1 Then

    .Range("B14:B" & LR).Copy
    Sheets("Sheet3").Range("B14").PasteSpecial xlPasteValues

    .Range("C14:C" & LR).Copy
    Sheets("Sheet3").Range("C14").PasteSpecial xlPasteValues

    .Range("D14:D" & LR).Copy
    Sheets("Sheet3").Range("D14").PasteSpecial xlPasteValues

    .Range("E14:E" & LR).Copy
    Sheets("Sheet3").Range("E14").PasteSpecial xlPasteValues

    .Range("F14:F" & LR).Copy
    Sheets("Sheet3").Range("F14").PasteSpecial xlPasteValues

    .Range("G14:G" & LR).Copy
    Sheets("Sheet3").Range("G14").PasteSpecial xlPasteValues

    .Range("H14:H" & LR).Copy
    Sheets("Sheet3").Range("H14").PasteSpecial xlPasteValues

    .Range("I14:I" & LR).Copy
    Sheets("Sheet3").Range("I14").PasteSpecial xlPasteValues

    .Range("J14:J" & LR).Copy
    Sheets("Sheet3").Range("J14").PasteSpecial xlPasteValues

    .Range("M14:M" & LR).Copy
    Sheets("Sheet3").Range("N14").PasteSpecial xlPasteValues

End If
.AutoFilterMode = False

End Sub

【问题讨论】：

标签： vba excel

【解决方案1】：

对于初学者来说，

.Range("B14:B" & LR).Copy
Sheets("Sheet3").Range("B14").PasteSpecial xlPasteValues

.Range("C14:C" & LR).Copy
Sheets("Sheet3").Range("C14").PasteSpecial xlPasteValues

.Range("D14:D" & LR).Copy
Sheets("Sheet3").Range("D14").PasteSpecial xlPasteValues

.Range("E14:E" & LR).Copy
Sheets("Sheet3").Range("E14").PasteSpecial xlPasteValues

.Range("F14:F" & LR).Copy
Sheets("Sheet3").Range("F14").PasteSpecial xlPasteValues

.Range("G14:G" & LR).Copy
Sheets("Sheet3").Range("G14").PasteSpecial xlPasteValues

.Range("H14:H" & LR).Copy
Sheets("Sheet3").Range("H14").PasteSpecial xlPasteValues

.Range("I14:I" & LR).Copy
Sheets("Sheet3").Range("I14").PasteSpecial xlPasteValues

.Range("J14:J" & LR).Copy
Sheets("Sheet3").Range("J14").PasteSpecial xlPasteValues

可以简写为：

.Range("B14:J" & LR).Copy
Sheets("Sheet3").Range("B14").PasteSpecial xlPasteValues

因为它是一个连续的范围

至于最后一个数据点下方的粘贴，可以使用类似：

Sheets("Sheet3").Range("B" & rows.count).end(xlup).offset(1,0).PasteSpecial xlPasteValues

基本上它在 B 列中从工作表的最后一行上升到最后一位数据（不会物理移动，但会计算出位置），然后偏移 1 行（换句话说，1 个单元格低于最后一位数据）

您也可以循环表格 1 和 2，这样您只需编写一次代码，无需重复（我也冒昧地为您声明了 LR 变量）。

Sub copyDataFromTwoSheetsIntoOneSheet()
Dim X As Long, LR As Long, PasteRow As Long
For X = 1 To 2
    With Sheets("Sheet" & X)
    .AutoFilterMode = False
    LR = .Range("B" & .Rows.Count).End(xlUp).Row
    .Range("B14:O" & LR).AutoFilter Field:=14, Criteria1:="<>"
    If LR > 1 Then
        PasteRow = Sheets("Sheet3").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row
        .Range("B14:J" & LR).Copy
        Sheets("Sheet3").Range("B" & PasteRow).PasteSpecial xlPasteValues
        If X = 1 Then
            .Range("O14:O" & LR).Copy
        Else
            .Range("M14:M" & LR).Copy
        End If
        Sheets("Sheet3").Range("N" & PasteRow).PasteSpecial xlPasteValues
    End If
    .AutoFilterMode = False
    End With
Next
End Sub

【讨论】：

您提供的代码有效，但正在复制的数据似乎从第 3000+ 行开始。我不明白它为什么那样做。顺便谢谢你回答我的问题。我真的很感激。

【解决方案2】：

您可以按如下方式重构您的代码：

Option Explicit

Sub copyDataFromTwoSheetsIntoOneSheet()
    Dim nFiltered As Long

    With Sheets("Sheet1")
        .AutoFilterMode = False
        With .Range("O14", .Cells(.Rows.count, "B").End(xlUp))
            .AutoFilter Field:=14, Criteria1:="<>"
            nFiltered = Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) - 1 '<--| count filtered cells excluding header row
            If nFiltered > 0 Then CopyFiltered .Cells, 0, 0, 9, 13, 1, 14
        End With
        .AutoFilterMode = False
    End With

    With Sheets("Sheet2")
        .AutoFilterMode = False
        With .Range("M14", .Cells(.Rows.count, "B").End(xlUp))
            .AutoFilter Field:=12, Criteria1:="<>"
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then CopyFiltered .Cells, IIf(nFiltered > 0, 1, 0), 0, 9, 11, 1, 14
        End With
        .AutoFilterMode = False
    End With
End Sub


Sub CopyFiltered(rng As Range, rowsReduction As Long, firstColumnOffset As Long, firstColumnResize As Long, secondColumnOffset As Long, secondColumnResize As Long, pasteSheetColumnToFindLastRowIn As Long)
    Dim lastRow As Long

    lastRow = WorksheetFunction.Max(14, Sheets("Sheet3").Cells(Rows.count, pasteSheetColumnToFindLastRowIn).End(xlUp).Offset(1).Row) '<--| get Sheet3 passed column row to start pasting from

    With rng.Resize(rng.Rows.count - rowsReduction).Offset(rowsReduction)
        .Offset(, firstColumnOffset).Resize(, firstColumnResize).SpecialCells(xlCellTypeVisible).Copy
        Sheets("Sheet3").Range("B" & lastRow).PasteSpecial xlPasteValues
        Application.CutCopyMode = False

        .Offset(, secondColumnOffset).Resize(, secondColumnResize).SpecialCells(xlCellTypeVisible).Copy
        Sheets("Sheet3").Range("N" & lastRow).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End With
End Sub

【讨论】：