How to select and copy a range of nonconsecutive columns with VBA

k10riley

New Member
Joined
Dec 1, 2021
Messages
24
Office Version
  1. 365
Platform
  1. Windows
Hi there,

I have some vba code where I am consolidating information from a series of workbooks into one page in another. However, I need to copy specifically Columns B, C, and G from Row 12 into one workbook where B, C, and G will be pasted into B, C, and D starting row 12. See the code below:

VBA Code:
Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    'location of workbooks you wish to consolidate information from
    Const strPath As String = "C:\2021 Survey\2020 Responses\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
        'change .sheets("insert sheet name of sheet to be copied per workbook").cells.find
            LastRow = .Sheets("2020 Response").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        'Change .Sheets("Insert Sheet Name of sheet to be copied per workbook").Range("Insert range to copy data" & LastRow) ... etc
        'The name of the sheet destination for copied data is located in wkbDest.Sheets("Input sheet name").Cells(rows.counts, "Insert where to paste copied data").End .... etc


'****** It is specifically here where I am stuck. I'm not sure how to get this portion to capture column G as well. It works great currently, but I'm missing the G column data*****

            .Sheets("2020 Response").Range("B12:C" & LastRow).Copy wkbDest.Sheets("2020 Consolidated Responses").Cells(rows.count, "B").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Additionally, I wanted to be able to clear the previous contents every time I run the code, but only clear B, C, and D in the "2020 Consolidated Responses." I had previously added some code with ClearContents but I end up erasing the entire sheet.

Thanks so much for your assistance!

This code should be attributed to these forums, I was able to get this great code to begin with thanks to mumps!
 
Last edited by a moderator:

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Hi & welcome to MrExcel.
How about
VBA Code:
Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    'location of workbooks you wish to consolidate information from
    Const strPath As String = "C:\2021 Survey\2020 Responses\"
    ChDir strPath
    
    wkbDest.Sheets("2020 Consolidated Responses").Range("B12:D" & Rows.Count - 100).ClearContents
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
        'change .sheets("insert sheet name of sheet to be copied per workbook").cells.find
            LastRow = .Sheets("2020 Response").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        'Change .Sheets("Insert Sheet Name of sheet to be copied per workbook").Range("Insert range to copy data" & LastRow) ... etc
        'The name of the sheet destination for copied data is located in wkbDest.Sheets("Input sheet name").Cells(rows.counts, "Insert where to paste copied data").End .... etc


'****** It is specifically here where I am stuck. I'm not sure how to get this portion to capture column G as well. It works great currently, but I'm missing the G column data*****

            .Sheets("2020 Response").Range("B12:C" & LastRow & ",G12:G" & LastRow).Copy wkbDest.Sheets("2020 Consolidated Responses").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi & welcome to MrExcel.
How about
VBA Code:
Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    'location of workbooks you wish to consolidate information from
    Const strPath As String = "C:\2021 Survey\2020 Responses\"
    ChDir strPath
   
    wkbDest.Sheets("2020 Consolidated Responses").Range("B12:D" & Rows.Count - 100).ClearContents
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
        'change .sheets("insert sheet name of sheet to be copied per workbook").cells.find
            LastRow = .Sheets("2020 Response").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        'Change .Sheets("Insert Sheet Name of sheet to be copied per workbook").Range("Insert range to copy data" & LastRow) ... etc
        'The name of the sheet destination for copied data is located in wkbDest.Sheets("Input sheet name").Cells(rows.counts, "Insert where to paste copied data").End .... etc


'****** It is specifically here where I am stuck. I'm not sure how to get this portion to capture column G as well. It works great currently, but I'm missing the G column data*****

            .Sheets("2020 Response").Range("B12:C" & LastRow & ",G12:G" & LastRow).Copy wkbDest.Sheets("2020 Consolidated Responses").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
That worked!! Thank you so much!

One other thing, For some reason it's copying the header (located in row 11)? I'm confused because the data starts on 12 of each sheet, how is it getting the data from 11?
 
Upvote 0
Or maybe I need to add some code to remove any duplicates?
 
Upvote 0
Not sure why it would copy the header row, is it happening on every file, or just some?
 
Upvote 0
Not sure why it would copy the header row, is it happening on every file, or just some?
It does it for just some! I went back and checked each one and the rows are all accurate. Not sure why it's doing that.

I added the following code:

'removes duplicates
wkbDest.Sheets("2020 Consolidated Responses").UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes

It works, however my header is in the top 11 rows (frozen panes). Any ideas on how to specify it to not delete my header?
 
Upvote 0
Set an actual range rather than usedRange
 
Upvote 0
Ok, Try it like
VBA Code:
wkbDest.Sheets("2020 Consolidated Responses").UsedRange.Offset(12).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
 
Upvote 0
Ok, Try it like
VBA Code:
wkbDest.Sheets("2020 Consolidated Responses").UsedRange.Offset(12).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
So, success in keeping headers! But there is one duplicate header from the copied workbooks still appearing. So strange!
 
Upvote 0

Forum statistics

Threads
1,214,535
Messages
6,120,093
Members
448,944
Latest member
SarahSomethingExcel100

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top