複製/粘貼工作表中的特定列到另一個

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