VBA to copy select columns and copy to a seperate worksheet

[fvisions]

I am looking for advice on where to begin. I have looked through forums and read the Mr. Excel VBA book but I am not looking to filter any information. What I am looking to do is for the end user to go to the ("Inventory Rpt") worksheet which has headers and columns A:AG, number of rows would vary. I want the vba to select 6 select column from the Inventory Rpt, (selected either by header or by row 2 to end of data in the selected column) tab and copy the information to the end of the data rows and paste in a new tab called "Contractor" in columns A:F with the same headers. What do you suggest as a starting point. Like I said I read some stuff but it talks about filtering the columns first, is this necessary?

 

[onlyadrafter]

Hello,

does this work as expected?

Sub COPY_6_COLUMNS()
    Application.ScreenUpdating = False
    With Sheets("Inventory Rpt")
        For MY_COLS = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
            Select Case .Cells(1, MY_COLS).Value
            Case "b", "c", "e", "f", "g", "h"
                .Columns(MY_COLS).Copy
                    If IsEmpty(Sheets("Contractor").Cells(1, Columns.Count).End(xlToLeft).Value) Then
                        Sheets("Contractor").Cells(1, Columns.Count).End(xlToLeft).PasteSpecial (xlPasteAll)
                    Else
                        Sheets("Contractor").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial (xlPasteAll)
                    End If
            End Select
        Next MY_COLS
    End With
    Application.ScreenUpdating = True
End Sub

all depends on how you want to determine which columns you want to copy over. Have just used row 1 where header contains b, c, e, f, g, or h. You can change the values to what you want.
The code will need to be changed if you have a different method of selecting the required 6 columns.

 

[fvisions]

Hello,

does this work as expected?

Sub COPY_6_COLUMNS()
    Application.ScreenUpdating = False
    With Sheets("Inventory Rpt")
        For MY_COLS = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
            Select Case .Cells(1, MY_COLS).Value
            Case "b", "c", "e", "f", "g", "h"
                .Columns(MY_COLS).Copy
                    If IsEmpty(Sheets("Contractor").Cells(1, Columns.Count).End(xlToLeft).Value) Then
                        Sheets("Contractor").Cells(1, Columns.Count).End(xlToLeft).PasteSpecial (xlPasteAll)
                    Else
                        Sheets("Contractor").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial (xlPasteAll)
                    End If
            End Select
        Next MY_COLS
    End With
    Application.ScreenUpdating = True
End Sub

all depends on how you want to determine which columns you want to copy over. Have just used row 1 where header contains b, c, e, f, g, or h. You can change the values to what you want.
The code will need to be changed if you have a different method of selecting the required 6 columns.

ok quick questions, the Contractor tab has some information for them so this data will have to be copied starting at row 15, how do I change If Is Empty to Row 15?

 

[onlyadrafter]

Hello,

Sub COPY_6_COLUMNS()
    Application.ScreenUpdating = False
    With Sheets("Inventory Rpt")
        For MY_COLS = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
            Select Case .Cells(1, MY_COLS).Value
            Case "b", "c", "e", "f", "g", "h"
                .Range(.Cells(1, MY_COLS), .Cells(.Cells(Rows.Count, MY_COLS).End(xlUp).Row, MY_COLS)).Copy
                    If IsEmpty(Sheets("Contractor").Cells(15, Columns.Count).End(xlToLeft).Value) Then
                        Sheets("Contractor").Cells(15, Columns.Count).End(xlToLeft).PasteSpecial (xlPasteAll)
                    Else
                        Sheets("Contractor").Cells(15, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial (xlPasteAll)
                    End If
            End Select
        Next MY_COLS
    End With
    Application.ScreenUpdating = True
End Sub

does that work?

 

[fvisions]

It only copies col AF to col a in the contractor report at row 15. I think I copied it all correctly.

Sub COPY_7_COLUMNS()
    Application.ScreenUpdating = False
    With Sheets("Full Inventory Rpt")
        For MY_COLS = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
            Select Case .Cells(1, MY_COLS).Value
            Case "E", "U", "V", "X", "AE", "AF", "AG"
                .Range(.Cells(1, MY_COLS), .Cells(.Cells(Rows.Count, MY_COLS).End(xlUp).Row, MY_COLS)).Copy
                    If IsEmpty(Sheets("Town of Inventory").Cells(15, Columns.Count).End(xlToLeft).Value) Then
                        Sheets("Town of Inventory").Cells(15, Columns.Count).End(xlToLeft).PasteSpecial (xlPasteAll)
                    Else
                        Sheets("Town of Inventory").Cells(15, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial (xlPasteAll)
                    End If
            End Select
        Next MY_COLS
    End With
    Application.ScreenUpdating = True
End Sub

 

[onlyadrafter]

Hello,

The above code works (for me anyway), but in the Case line you need to change E, U etc, to whatever is in the cells in Row 1 on the specified columns.
i.e. if E1 has SUPPLIER then you need to change "E" to "SUPPLIER" and so on.

alternatively, try

Sub COPY_7_COLUMNS_NOS()
    Application.ScreenUpdating = False
    With Sheets("Full Inventory Rpt")
        For MY_COLS = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
            Select Case MY_COLS
            Case 5, 21, 22, 24, 31, 32, 33
                .Range(.Cells(1, MY_COLS), .Cells(.Cells(Rows.Count, MY_COLS).End(xlUp).Row, MY_COLS)).Copy
                    If IsEmpty(Sheets("Town of Inventory").Cells(15, Columns.Count).End(xlToLeft).Value) Then
                        Sheets("Town of Inventory").Cells(15, Columns.Count).End(xlToLeft).PasteSpecial (xlPasteAll)
                    Else
                        Sheets("Town of Inventory").Cells(15, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial (xlPasteAll)
                    End If
            End Select
        Next MY_COLS
    End With
    Application.ScreenUpdating = True
End Sub

which runs on the column number