VBA Copy / Paste with Column Spaces?

[Glasgowsmile]

Good day,

I have the following code:

  ' Import Date through Index
         Range("A6:E185").Copy
         wkbCrntWorkBook.Sheets("Segmentation").Range("A4").PasteSpecial xlPasteValues
       
         ' Import Group
       
         Range ("G6:I185")
         wkbCrntWorkBook.Sheets("Segmentation").Range("G4").PasteSpecial xlPasteValues

I would like to fix the code so I don't have to go back and forth between worksheets copying a few columns and pasting a few columns. I would like to copy the full range 1x and paste into A4 but the issue is that column F has formulas in it so I need to skip this column when it pastes in the data.

How would I go about doing that?

 

[VBE313]

You could just paste over it and then add the Formula back into Column F like this..

Sub test()
With Sheets("Sheet1")
    .Range("A6:I185").Copy
    With Sheets("Segmentation")
        .Range("A4").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        .Range("F4").Formula = "=SUM(A1)"
        .Range("F4").AutoFill Destination:=Range("F4:F185"), Type:=xlFillDefault
    End With
End With
End Sub

 

[Glasgowsmile]

You could just paste over it and then add the Formula back into Column F like this..

Sub test()
With Sheets("Sheet1")
    .Range("A6:I185").Copy
    With Sheets("Segmentation")
        .Range("A4").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        .Range("F4").Formula = "=SUM(A1)"
        .Range("F4").AutoFill Destination:=Range("F4:F185"), Type:=xlFillDefault
    End With
End With
End Sub

Interesting idea.

Let's say, I had 10 columns that I needed to 'skip' over or in your example, re-add formulas to.

Would it be better to just copy/paste from the worksheet to those specific columns I need or better to copy/paste 1x and then re-add the formulas through VBA?

I feel like the quicker and less resource-intensive process might be to add the formulas with VBA.

 

[VBE313]

Yes I feel that adding formulas are more efficient. The less copying and pasting the better.

 

[Glasgowsmile]

Yes I feel that adding formulas are more efficient. The less copying and pasting the better.

What if I need to copy data A1:G6 from another worksheet and I want to paste it in A4 but the data needs to actually show up in A1 and E1:H6 - so I basically need to skip 3 columns entirely instead of having it copy data into those.

Would that be a situation where I need to write VBA to just copy/paste separately to avoid the columns or is there some code for a quicker fix?

 

[davesexcel]

You could set up the ranges you want to copy, then you can do it all at once, leaving the formulas alone.

Sub ResizeToDifferentSheet()

    Dim sh As Worksheet, ws As Worksheet
    Dim rng1 As Variant, rng2 As Variant
    Dim r1 As Long, c1 As Long
    Dim r2 As Long, c2 As Long

    Set sh = Sheets("Source")
    Set ws = Sheets("Segmentation")

    With sh
        rng1 = .Range("A6:E185").Value
        rng2 = .Range("G6:I185").Value
       
        r1 = UBound(rng1, 1): c1 = UBound(rng1, 2)
        r2 = UBound(rng2, 1): c2 = UBound(rng2, 2)
    End With

 
    With ws
        .Range("A4").Resize(r1, c1).Value = rng1
        .Range("G4").Resize(r2, c2).Value = rng2
    End With
End Sub

 

[Glasgowsmile]

You could set up the ranges then you can do it all at once, leaving the formulas alone.

Sub ResizeToDifferentSheet()

    Dim sh As Worksheet, ws As Worksheet
    Dim rng1 As Variant, rng2 As Variant
    Dim r1 As Long, c1 As Long
    Dim r2 As Long, c2 As Long

    Set sh = Sheets("Source")
    Set ws = Sheets("Segmentation")

    With sh
        rng1 = .Range("A6:E185").Value
        rng2 = .Range("G6:I185").Value
       
        r1 = UBound(rng1, 1): c1 = UBound(rng1, 2)
        r2 = UBound(rng2, 1): c2 = UBound(rng2, 2)
    End With

 
    With ws
        .Range("A4").Resize(r1, c1).Value = rng1
        .Range("G4").Resize(r2, c2).Value = rng2
    End With
End Sub

What exactly is the UBound commands?

 

[davesexcel]

They count the rows and columns in the range arrays.

 

[Glasgowsmile]

They count the rows and columns in the range arrays.

How can I change Set sh = to just the sourcebook instead of naming the sheets? because the sheet name from the source is constantly changing.

Currently, I'm using:

If .SelectedItems.Count > 0 Then
         Workbooks.Open .SelectedItems(1)
         Set wkbSourceBook = ActiveWorkbook

In fact, might be easier if I just share the whole code:

Sub Segmentation()
   Application.DisplayAlerts = False
   Dim wkbCrntWorkBook As Workbook
   Dim wkbSourceBook As Workbook
  
   Dim sh As Worksheet, ws As Worksheet
   Dim rng1 As Variant, rng2 As Variant
   Dim r1 As Long, c1 As Long
   Dim r2 As Long, C2 As Long
  
   Set wkbCrntWorkBook = ActiveWorkbook
   With Application.FileDialog(msoFileDialogOpen)
      .Filters.Clear
      .Filters.Add "Excel 2007-13", "*.xlsx; *.xls; *.xlsm; *.xlsa"
      .AllowMultiSelect = False
      .Show
       If .SelectedItems.Count > 0 Then
         Workbooks.Open .SelectedItems(1)
         Set wkbSourceBook = ActiveWorkbook
      
      Set sh = wkbSourceBook
      Set ws = Sheets("Segmentation")
      
      
      wkbCrntWorkBook.Sheets("Segmentation").Range("A3:I185, N3:P185, U3:W185, AB3:AD185, AI3:AK185, AP3:AR185, AW3:AY185, BD3:BF185").ClearContents
    
        
         With sh
        rng1 = .Range("A6:E185").Value
        rng2 = .Range("G6:I185").Value
        
        r1 = UBound(rng1, 1): c1 = UBound(rng1, 2)
        r2 = UBound(rng2, 1): C2 = UBound(rng2, 2)
    End With

 
    With ws
        .Range("A4").Resize(r1, c1).Value = rng1
        .Range("G4").Resize(r2, C2).Value = rng2
    End With
    
         ' Import Date through Index
         Range("A6:BI185").Copy
         wkbCrntWorkBook.Sheets("Segmentation").Range("A4").PasteSpecial xlPasteValues
        
         wkbSourceBook.Close False
        
         Range("A3:A500").NumberFormat = "dd-mmm-yy"
         Range("C3:D500,G3:H500,K3:L500,O3:P500,S3:T500,W3:X500,AA3:AB500,AE3:AF500,AI3:AJ500").NumberFormat = "0.0%"
         Range("A3:AK200").HorizontalAlignment = xlCenter
        
      End If
         Application.CutCopyMode = False
   End With
  
myerror:
        With Application
            .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic
        End With
        If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

 

[davesexcel]

Add to the ranges you need to copy.

Sub Segmentation()
    Application.DisplayAlerts = False
    Dim wkbCrntWorkBook As Workbook
    Dim wkbSourceBook As Workbook
  
    Dim sh As Worksheet, ws As Worksheet
    Dim rng1 As Variant, rng2 As Variant
    Dim r1 As Long, c1 As Long
    Dim r2 As Long, C2 As Long
  
    Set wkbCrntWorkBook = ThisWorkbook
    Set sh = wkbCrntWorkBook.Sheets("Segmentation")

    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "Excel 2007-13", "*.xlsx; *.xls; *.xlsm; *.xlsa"
        .AllowMultiSelect = False
        .Show
        Application.ScreenUpdating = False
        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set wkbSourceBook = ActiveWorkbook
            Set ws = wkbSourceBook.Sheets(1)
      
      
            'wkbCrntWorkBook.Sheets("Segmentation").Range("A3:I185, N3:P185, U3:W185, AB3:AD185, AI3:AK185, AP3:AR185, AW3:AY185, BD3:BF185").ClearContents
    
        
            With ws
                rng1 = .Range("A6:E185").Value
                rng2 = .Range("G6:I185").Value
        
                r1 = UBound(rng1, 1): c1 = UBound(rng1, 2)
                r2 = UBound(rng2, 1): C2 = UBound(rng2, 2)
            End With

 
            With sh
            
                .Range("A4").Resize(r1, c1).Value = rng1
                .Range("G4").Resize(r2, C2).Value = rng2
            End With
    
            ' Import Date through Index
            '            Range("A6:BI185").Copy
            '            wkbCrntWorkBook.Sheets("Segmentation").Range("A4").PasteSpecial xlPasteValues
        
            wkbSourceBook.Close False
        
            Range("A3:A500").NumberFormat = "dd-mmm-yy"
            Range("C3:D500,G3:H500,K3:L500,O3:P500,S3:T500,W3:X500,AA3:AB500,AE3:AF500,AI3:AJ500").NumberFormat = "0.0%"
            Range("A3:AK200").HorizontalAlignment = xlCenter
        
        End If
        Application.CutCopyMode = False
    End With
  
    'myerror:
    '    With Application
    '        .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic
    '    End With
    '    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub