Question

我的工作簿中有两张纸。一个实际上是一个临时工作表，其中包含大量员工数据，并且有超过50列。还有另一张表限制为10列，实际上是过滤列表，列是为了报告。很少列是公式列，也基于另一列的值。

所以我要做的就是从Sheet1 (Temp_Data)中复制这些列并将其粘贴到主页中，其中列已被删除，并且顺序也不同。

所以我正在做的是，单独复制并将其粘贴到最终工作表的相应列中。

喜欢这样：

Sheets("Temp_Data").Range(cells(2,1),cells(lastrow,1)).copy
Sheets("Final_Invoice").Range("G2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Sheets("Temp_Data").Range(cells(2,7),cells(lastrow,7)).copy
Sheets("Final_Invoice").Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

因此，对Temp_Data到Final_Invoice所需的所有列重复此过程。

但我真的相信应该有一些最简单的方法来替换它，比如列之间的映射。

任何建议深表感谢

Answer 1

至少你可以用更短的版本。当我进行这种复制和粘贴时，我基本上有一个像这样的自己的匹配函数（因为你有时会在Application.Match中得到不可见的错误）：

Function ownMatch(s As String, rng As Range) As Long
  ownMatch = 0
  On Error Resume Next ' resume if error occurs after this
  ownMatch = Application.Match(s, rng, 0) ' get cell with value s in it
  On Error GoTo 0 ' turn on errors again
End Function

然后我只是在循环中使用该函数。所以当你有10列时，它看起来像这样：

Sub copyAndSortCols()
Dim i As Long, lColToCopy As Long, lastrow As Long
Dim vColumnsToCopy
Dim wsTemp As Worksheet, wsFinInv As Worksheet
  [... other code ...]
  Set wsTemp = ThisWorkbook.Sheets("TempData")
  Set wsFinInv = ThisWorkbook.Sheets("Final_Invoice")
  vColumnsToCopy = Array("Column1", "Column2", "Column3") ' fill this with your column names that you want to copy
  For i = 0 To UBound(vColumnsToCopy)
    lColToCopy = ownMatch(CStr(vColumnsToCopy(i)), wsTemp.Rows(1)) ' find column in row 1 of TempData
    If lColToCopy > 0 Then ' if there is a match
      wsTemp.Range(wsTemp.Cells(1, lColToCopy), wsTemp.Cells(lastrow, lColToCopy)).Copy _
        Destination:=wsFinInv.Cells(1, i + 1)
    End If
  Next i
  [... other code ...]
End Sub

确保以相同的顺序填充数组，将列粘贴到另一个工作表中。如果您有任何问题，请告诉我。

Answer 2

我假设您要粘贴的列的名称包含在目标工作表的第1行中，并且与源表中的列名称完全匹配，也在第1行中。在这种情况下，您可以只需遍历源表中的所有标题，并检查它们是否存在于目标表中。如果找到匹配，请复制该列。

这是一个基本的工作示例

Sub copyColumns()

    Set wsSource = ThisWorkbook.Sheets("Sheet2") 'Define sheet with source columns
    Set wsDest = ThisWorkbook.Sheets("Sheet1") 'Destination sheet, this contains the columns headings

    For intCol1 = 1 To wsSource.UsedRange.Columns.Count

        For intCol2 = 1 To wsDest.UsedRange.Columns.Count

            If LCase(wsSource.Cells(1, intCol1)) = LCase(wsDest.Cells(1, intCol2)) Then
                wsSource.Columns(intCol1).Copy
                wsDest.Cells(1, intCol2).PasteSpecial xlPasteValues


            End If
        Next intCol2


    Next intCol1

End Sub

如果您正在尝试做其他事情，请发表评论

Answer 3

感谢@ashleedawg提供映射提示。我分享了一个我试过的解决方案。但它不是一个干净的解决方案，但对于那些有相似情况的人可以使用它。

首先，我创建了一个看起来像这样的映射数组

dim mapper() as string
mapper=split("A-D,B-H,E-A,G-E",",")

这里我们将源表中的列映射到dest表。例如，在A-D中表示临时表A列映射到dest表中的D列

dim s as variant
for each s in mapper
    Dim map() As String
    map = Split(s, "-")
        With Sheets("Invoice")
            myRange.Range(Cells(1, CInt(map(0))), Cells(myRange.Rows.count, CInt(map(0)))).Copy
            .Range(map(1) & "2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
next

循环实际上是通过使用 - （连字符）分割创建的数组进行迭代，它给出了所有列的映射。再次在循环内部，我们将分为源和目标的不同部分。

从工作表复制范围并粘贴到不同列中的另一个工作表中

3 个答案: