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

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列的标签，是我用什么上面的代码，但如果这种假设不正确，修复应该是相当不言而喻。我还将复制的列堆叠到右侧的第一个可用列中。您的代码可能已将它们置于原始位置。

当你运行上面的，请注意，它会删除名为物料主或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