Copy/Paste Specific Columns from a Worksheet to another

Question

I want to copy some columns with headers from a worksheet to another one. I've created an array that looks for the different headers needed so I can copy and paste the entire column into the new tab. I know I have an error somewhere because I'm getting a type mismatch error and possibly other types as well. Can someone take a look and see what I'm missing/have wrong?

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

score 0 · Answer 1 · answered Nov 23 '14 at 03:51

I prefer to use Application.Match to locate a specific column header label rather than cycling through them trying to find a match. To that end, I've heavily modified your code.

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

Correct me if I'm wrong, but your code seemed to be looking for the column labels in row 4. That is what I'm using above but if that assumption is incorrect then the fix should be fairly self-evident. I've also stacked the copied columns into the first available column to the right. Your code may have been putting them in the original position.

When you run the above, please note that it will remove worksheets named Material Master or BOM without asking in favor of inserting its own worksheets of those names. Given that, it's probably best to run on a copy of your original.

Hi, yes it is looking for column labels in row 4. I tried out the code but it only copied "Material Description". It probably pasted everything in the same column. I'm not sure how to fix it. — gssd, Dec 09 '14 at 00:49

Dustin · Answer 2 · 2014-12-09T02:50:25.903

Using the Find() method is a very efficient way of finding the data you want. Below are a few suggestions to optimize your existing code.

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

Hi, I tried out your code, but it gives an "Object doesn't support this property or method." error. Any thoughts on why? — gssd, Dec 09 '14 at 00:45

Copy/Paste Specific Columns from a Worksheet to another

2 Answers2