從工作表復制范圍，然后粘貼到不同列的另一工作表中

Question

我的工作簿中有兩張紙。 一個實際上是一張臨時表，其中包含大量員工數據，並且有50多個列。 還有另一個工作表，該工作表僅限於10列，實際上是經過過濾的列表，並且各列是為了進行報告。 很少有幾列是公式列，它們也基於另一列的值。

因此，我要做的是從Sheet1 (Temp_Data)復制這些列，然后將其粘貼到Main表中，同時刪除列，並且順序也不同。

因此，我要做的是分別復制並將其粘貼到最終工作表的相應列中。

像這樣：

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",",") 

在這里，我們將列從源工作表映射到目標工作表。 例如在AD中表示溫度表A列映射到目標表中的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

循環實際上是遍歷使用-（連字符）進行拆分所創建的數組，該數組給出了所有列的映射。 同樣，在循環內部，我們將源和目標分為不同的部分。