VBA to copy select columns and copy to a seperate worksheet

fvisions

Board Regular
Joined
Jul 29, 2008
Messages
174
Office Version
  1. 365
Platform
  1. Windows
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?
 

Some videos you may like

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

onlyadrafter

Well-known Member
Joined
Aug 19, 2003
Messages
5,703
Platform
  1. Windows
Hello,

does this work as expected?

VBA Code:
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

Board Regular
Joined
Jul 29, 2008
Messages
174
Office Version
  1. 365
Platform
  1. Windows
Hello,

does this work as expected?

VBA Code:
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

Well-known Member
Joined
Aug 19, 2003
Messages
5,703
Platform
  1. Windows
Hello,

VBA Code:
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

Board Regular
Joined
Jul 29, 2008
Messages
174
Office Version
  1. 365
Platform
  1. Windows
It only copies col AF to col a in the contractor report at row 15. I think I copied it all correctly.

VBA Code:
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

Well-known Member
Joined
Aug 19, 2003
Messages
5,703
Platform
  1. Windows
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

VBA Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,114,111
Messages
5,546,000
Members
410,720
Latest member
SSL
Top