vba to copy specific columns into new worksheet

sdhutty

Board Regular
Joined
Jul 15, 2016
Messages
207
Hi there,

I currently have this code whereby it extracts a worksheet and saves into a new workbook.

I am trying to make it extract from row 5 and below.

From columns O-U are locations as follows:

Column O: Marston Green
Column P: Test Engineering
Column Q: West Hartford
Column R: Singapore
Column S: Xiamen
Column T: Neuss
Column U:Dubai

I have a userform interface with checkboxes.

I want the code to program so if you select a checkbox it extracts the specific columns according to that checkbox. You can see the columns I want to be extracted:

Marston Green: B:O
Test Engineering: B:N,P:P
West Hartford: B:N,Q:Q
Singapore: B:B,R:R
Xiamen: B:B,S:S
Neuss: B:B,T:T
Dubai: B:N,U:U

Also if its possible to extract two checkboxes at once. Because I try to do this and it says 'cannot changed part of merged cell.' Also when I run the code the 'save as filename' doesn't work.

Here is the code I currently have:

Code:
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdClear_Click()
'Clear the form
    For Each ctl In Me.Controls
    If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
        ctl.Value = ""
    ElseIf TypeName(ctl) = "CheckBox" Then
        ctl.Value = False
    End If
   Next ctl
End Sub
Private Sub cmdExtract_Click()
If MsgBox("                   Please Confirm?", vbYesNo) = vbNo Then Exit Sub
Application.DisplayAlerts = False
Dim wb As Workbook, InitFileName As String, fileSaveName As String
    InitFileName = ThisWorkbook.Path & "\ Extracted_Register_" & Format(Date, "dd-mm-yyyy")
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    
If cbxMarstonGreen = True Then
Range("B5:O1048576").Copy
End If
If cbxTestEngineering = True Then
Range("B:N,P:P").Copy
End If
If cbxWestHartford = True Then
Range("B:N,Q:Q").Copy
End If
If cbxSingapore = True Then
Range("B:N,R:R").Copy
End If
If cbxXiamen = True Then
Range("B:N,S:S").Copy
End If
If cbxNeuss = True Then
Range("B:N,T:T").Copy
End If
If cbxDubai = True Then
Range("B:N,U:U").Copy
End If

Set wb = ActiveWorkbook
 fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitFileName, _
    filefilter:="Excel files , *.xlsx")
    
     With wb
        If fileSaveName <> "False" Then
             
            .SaveAs fileSaveName
            .Close
        Else
            .Close False
            Exit Sub
        End If
    End With
    
MsgBox ("Extraction Completed")
Unload Me
Application.DisplayAlerts = True
End Sub
Private Sub UserForm_Click()
End Sub

Thank you.
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

Forum statistics

Threads
1,214,861
Messages
6,121,969
Members
449,059
Latest member
oculus

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