VBA to open file, clear formats and copy paste

colzre

New Member
Joined
Jan 8, 2024
Messages
25
Office Version
  1. 365
Platform
  1. Windows
Hello Experts,

I am using the below VBA to open an excel workbook in a separate excel file elsewhere and copy paste 2 columns. It works fine however I am trying to clear the formatting as has merged cells and ends up transfering all columns in that merged range.

Would anyone know which addition to insert into my VBA to clear the formatting before copying and pasting the columns? So the copy paste would be work. I have tried a few attempts with no success.


Sub Jan_credits()

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'*****************set variables

Dim ws As Worksheet
Dim wkbk
Dim wkbk2
Set wkbk = ActiveWorkbook



'*****************Extraction


fname = Application.GetOpenFilename
If fname <> False Then
Workbooks.Open Filename:=fname
Else: Exit Sub
End If

Set wkbk2 = ActiveWorkbook


'*****************Copy and paste

ActiveWindow.WindowState = xlMaximized


Range("d2:d500").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
wkbk.Activate
Range("ba3012").Select
Selection.PasteSpecial Paste:=xlValues
wkbk2.Activate

Range("f2:f500").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
wkbk.Activate
Range("bb3012").Select
Selection.PasteSpecial Paste:=xlValues
wkbk2.Activate




wkbk2.Close
wkbk.Activate


End Sub





Thanks!
John
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Try this on a copy.
VBA Code:
Sub Jan_credits()
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '*****************set variables
    Dim ws As Worksheet
    Dim wkbk
    Dim wkbk2
    Set wkbk = ActiveWorkbook

    '*****************Extraction
    fname = Application.GetOpenFilename
    If fname <> False Then
        Workbooks.Open Filename:=fname
    Else
        Exit Sub
    End If
    Set wkbk2 = ActiveWorkbook

    '*****************Copy and paste
    ActiveWindow.WindowState = xlMaximized

    ' Clear formatting
    wkbk2.Sheets(1).Range("D2:D500").EntireColumn.ClearFormats
    wkbk2.Sheets(1).Range("F2:F500").EntireColumn.ClearFormats

    ' Copy and paste values
    wkbk2.Sheets(1).Range("D2:D500").Copy
    wkbk.Sheets(1).Range("BA3012").PasteSpecial Paste:=xlValues
    wkbk2.Sheets(1).Range("F2:F500").Copy
    wkbk.Sheets(1).Range("BB3012").PasteSpecial Paste:=xlValues

    Application.CutCopyMode = False

    wkbk2.Close
    wkbk.Activate
End Sub
 
Upvote 0
Try this on a copy.
VBA Code:
Sub Jan_credits()
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '*****************set variables
    Dim ws As Worksheet
    Dim wkbk
    Dim wkbk2
    Set wkbk = ActiveWorkbook

    '*****************Extraction
    fname = Application.GetOpenFilename
    If fname <> False Then
        Workbooks.Open Filename:=fname
    Else
        Exit Sub
    End If
    Set wkbk2 = ActiveWorkbook

    '*****************Copy and paste
    ActiveWindow.WindowState = xlMaximized

    ' Clear formatting
    wkbk2.Sheets(1).Range("D2:D500").EntireColumn.ClearFormats
    wkbk2.Sheets(1).Range("F2:F500").EntireColumn.ClearFormats

    ' Copy and paste values
    wkbk2.Sheets(1).Range("D2:D500").Copy
    wkbk.Sheets(1).Range("BA3012").PasteSpecial Paste:=xlValues
    wkbk2.Sheets(1).Range("F2:F500").Copy
    wkbk.Sheets(1).Range("BB3012").PasteSpecial Paste:=xlValues

    Application.CutCopyMode = False

    wkbk2.Close
    wkbk.Activate
End Sub

Thank you for your response.

Unfortunately same issue persists.

It copies the entire range of columns which is under the merged formatting rather than one column only, as wished to.
 
Upvote 0
Do you just mean something like this ?

VBA Code:
    Columns("D").MergeCells = False
    Columns("F").MergeCells = False
 
Upvote 0
Solution
Do you just mean something like this ?

VBA Code:
    Columns("D").MergeCells = False
    Columns("F").MergeCells = False
I have tried that adding it to the existing VBA and comes as below. Still did not copy and paste only the columns chosen only but the whole thing merged:

VBA Code:
Sub Jan_credits()

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'*****************set variables
    
Dim ws As Worksheet
Dim wkbk
Dim wkbk2
Set wkbk = ActiveWorkbook



'*****************Extraction



     fname = Application.GetOpenFilename
    If fname <> False Then
    Workbooks.Open Filename:=fname
    Else: Exit Sub
    End If

Set wkbk2 = ActiveWorkbook

'*****************Copy and paste
    ActiveWindow.WindowState = xlMaximized
    
     Columns("D").MergeCells = False
    Columns("F").MergeCells = False
    
    Range("d2:d500").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wkbk.Activate
    Range("ba3012").Select
    Selection.PasteSpecial Paste:=xlValues
    wkbk2.Activate
    
     Range("f2:f500").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wkbk.Activate
    Range("bb3012").Select
    Selection.PasteSpecial Paste:=xlValues
    wkbk2.Activate

    
    

wkbk2.Close
wkbk.Activate
    

End Sub
 
Upvote 0
You are going to have to give us some visibilty over what your spreadsheet looks like and what it is doing and not doing.
Ideally provide us an XL2BB sample of your data.
 
Upvote 0
You are going to have to give us some visibilty over what your spreadsheet looks like and what it is doing and not doing.
Ideally provide us an XL2BB sample of your data.
Of course. Here you have. The last row is the one in question where it´s merged and not enabling me to get column D without the rest on merge.

The VBA should be copying column D and F only then pasting it however the merged cells act as all columns to paste rather than only the picked ones.

Credits.xlsx
ABCDEFGHIJKLMN
1DataNumberDocumentClient1AmountVATDatePayerVoucherDate2Document2ClientNote
2Deselezionato29/02/2024447FHEName209.9310%31/03/2024Agency1Name
3Deselezionato29/02/2024443FHEName200.0010%31/03/2024Agency1Name
4Deselezionato29/02/2024438FHEName200.0010%31/03/2024Agency1Name
5Deselezionato29/02/2024434FHEName200.0010%31/03/2024Agency1Name
6Deselezionato29/02/2024433FHEName200.0010%31/03/2024Agency1Name
7Deselezionato29/02/2024432FHEName200.0010%31/03/2024Agency1Name
8Deselezionato29/02/2024431FHEName200.0010%31/03/2024Agency1Name
9Deselezionato28/02/2024429FHEName1,200.0022%31/03/2024Agency1Name
10Deselezionato28/02/2024428FHEName74.9222%31/03/2024Agency1Name
11Deselezionato28/02/2024427FHEName37.4222%31/03/2024Agency1Name
12Deselezionato28/02/2024424FHEName420.0010%31/03/2024Agency1Name
13Deselezionato27/02/2024421FHEName200.0010%31/03/2024Agency1Name
14Deselezionato19/02/2024338FHEName420.0010%31/03/2024Agency1Name
15Deselezionato20/02/2024357FHEName74.9210%31/03/2024Agency1Name
16Deselezionato20/02/2024357FHEName74.9222%31/03/2024Agency1Name
1747,712.10
Sheet
 
Upvote 0
So when I run it the result is this, what are you expecting ?

20240310 VBA Copy Merged Cells colzre.xlsm
BABB
3012FHE209.93
3013FHE200
3014FHE200
3015FHE200
3016FHE200
3017FHE200
3018FHE200
3019FHE1200
3020FHE74.92
3021FHE37.42
3022FHE420
3023FHE200
3024FHE420
3025FHE74.92
3026FHE74.92
302747712.1
Sheet1
 
Upvote 0
So when I run it the result is this, what are you expecting ?

20240310 VBA Copy Merged Cells colzre.xlsm
BABB
3012FHE209.93
3013FHE200
3014FHE200
3015FHE200
3016FHE200
3017FHE200
3018FHE200
3019FHE1200
3020FHE74.92
3021FHE37.42
3022FHE420
3023FHE200
3024FHE420
3025FHE74.92
3026FHE74.92
302747712.1
Sheet1
I have seen it now!

Sorted!!


Thanks, I appreciate it
 
Upvote 0

Forum statistics

Threads
1,224,785
Messages
6,180,945
Members
453,007
Latest member
anaysha1

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