将特定的列从工作表复制/粘贴到另一个

Question

我想将一些带有标题的列从一个工作表复制到另一个。 我创建了一个数组，用于查找所需的不同标题，以便将整个列复制并粘贴到新选项卡中。 我知道我在某处出错，因为我遇到了类型不匹配的错误，可能还有其他类型的错误。 有人可以看一看，我想念/错了吗？

Dim rngCell As Range
Dim strHeader() As String
Dim intColumnsMax As Integer

Sheets.Add.Name = "Material Master"
Sheets.Add.Name = "BOM"

intColumnsMax = Sheets("HW Zpure Template").UsedRange.Columns.Count
ReDim strHeader(1 To intColumnsMax)

strHeader(1) = "MATERIAL"
strHeader(2) = "MATERIAL TYPE"
strHeader(3) = "MATERIAL DESCRIPTION"

For Each rngCell In Rows(4)
    For i = 1 To intColumnsMax
        If strHeader(i) = rngCell.Value Then
            rngCell.EntireColumn.Copy
                Sheets("Material Master").Select
                ActiveSheet.Paste Destination:=Worksheets("Material Master").Cells(1, i)
                Sheets("HW Zpure Template").Select
        End If
    Next i
Next 

Answer 1

我更喜欢使用Application.Match来定位特定的列标题标签，而不是循环遍历它们以查找匹配项。 为此，我已经大量修改了您的代码。

Dim c As Long, v As Long, vHDRs As Variant
Dim s As Long, vNWSs As Variant, wsMM As Worksheet

vHDRs = Array("MATERIAL", "MATERIAL TYPE", "MATERIAL DESCRIPTION")
vNWSs = Array("Material Master", "BOM")

For v = LBound(vNWSs) To UBound(vNWSs)
    For s = 1 To Sheets.Count
        If Sheets(s).Name = vNWSs(v) Then
            Application.DisplayAlerts = False
            Sheets(s).Delete
            Application.DisplayAlerts = True
            Exit For
        End If
    Next s
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = vNWSs(v)
Next v

Set wsMM = Sheets("Material Master")
With Sheets("HW Zpure Template")
    For v = LBound(vHDRs) To UBound(vHDRs)
        If CBool(Application.CountIf(.Rows(4), vHDRs(v))) Then
            c = Application.Match(vHDRs(v), .Rows(4), 0)
            Intersect(.UsedRange, .Columns(c)).Copy _
              Destination:=wsMM.Cells(1, Application.CountA(wsMM.Rows(1)) + 1)
        End If
    Next v
End With
Set wsMM = Nothing

如果我错了，请纠正我，但是您的代码似乎正在寻找第4行中的列标签。这就是我在上面使用的内容，但是如果这种假设不正确，则修复应该是不言而喻的。 我还将复制的列堆叠到右侧的第一个可用列中。 您的代码可能已将它们放到原始位置。

当您运行上述代码时，请注意，它将删除名为Material Master或BOM的工作表，而不会要求插入自己的工作表。 鉴于此，最好在原始副本上运行。

Answer 2

使用Find（）方法是查找所需数据的一种非常有效的方法。 以下是一些优化现有代码的建议。

Dim rngCell As Range
Dim strHeader() As String
Dim intColumnsMax As Integer
Dim i As Integer

Sheets.Add.Name = "Material Master"
Sheets.Add.Name = "BOM"

'Quick way to load a string array
'This example splits a comma delimited string.
'If your headers contain commas, replace the commas in the next line of code
'with a character that does not exist in the headers.
strHeader = Split("MATERIAL,MATERIAL TYPE,MATERIAL DESCRIPTION", ",")

'Only loop through the headers needed
For i = LBound(strHeader) To UBound(strHeader)
    Set rngCell = Sheets("HW Zpure Template").UsedRange.Find(What:=strheader(i), LookAt:=xlWhole)
    If Not rngCell Is Nothing Then

        'Taking the intersection of the used range and the entire desired column avoids
        'copying a lot of unnecessary cells.
        Set rngCell = Intersect(Sheets("HW Zpure Template").UsedRange, rngCell.EntireColumn)

        'This method is more memory consuming, but necessary if you need to copy all formatting
        rngCell.Copy Destination:=Worksheets("Material Master").Range(rngCell.Address)

        'This method is the most efficient if you only need to copy the values
        Worksheets("Material Master").Range(rngCell.Address).Value = rngCell.Value
    End If
Next i