VBA Paste Column in Non-Sequential Order

Hi Experts,

Looking for a little assistance,  I need to copy over some columns the range is A7:C70, F7:I70,K7:K70,D7:D70,L7:L70, DE7:EZ70 in this order.  However when I run the vba it copies the data over in sequential order.  How would I update the vba to place in the order specified?

Here is the macro
Sub BCopySummaryData()
    Dim wb As Workbook
    Dim fso As FileSystemObject
    Dim myFolder As Folder
    Dim myFile As File
    Dim newestFile As File
    Dim ws As Worksheet
    
    Set fso = New FileSystemObject
    
  'Delete Current Data below header
    With Sheets("BSum")
            Rows("7:65536").Select
            Selection.Delete
            Range("A7").Select
        End With
    
    Application.AskToUpdateLinks = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    '--------------------------------------------------------------------------------
    'For test purposes, I am using the "My Documents" folder... this needs to change
    ' To use whatever folder you need
    '--------------------------------------------------------------------------------
    
    
    Set myFolder = fso.GetFolder("\\SSFilePrint\GROUPSHARE\Store Planning\LSP Shared")
    
        
    For Each myFile In myFolder.Files
        Select Case UCase(fso.GetExtensionName(myFile.Path))
            Case "XLS", "XLSM", "XLSB", "XLSX":
        
                If newestFile Is Nothing Then
                    Set newestFile = myFile
                ElseIf myFile.DateLastModified > newestFile.DateLastModified Then
                    Set newestFile = myFile
                End If
        End Select
    Next


   
    '--------------------------------------------------------------------------------
    'At this point... "newestFile" is a File object that is the newest Excel File in your folder
    ' The following code will open it, and now you have to copy from whatever range you need data from
    '--------------------------------------------------------------------------------
   
    
    If Not newestFile Is Nothing Then
        Application.Workbooks.Open newestFile.Path
        Set wb = Application.Workbooks(newestFile.Name)
    'or if you now the name of the sheet it could be something like : Set ws = wb.Sheets("Sheet1")
        Set ws = wb.Sheets("Summary")
        
     Set lastSourceCell = LastCell(ws)
        If lastSourceCell Is Nothing Then
            MsgBox "Nothing to copy - stopping"
            wb.Close
            Exit Sub
        End If
        
        Set lastDestCell = LastCell(ThisWorkbook.Sheets("BSum"))
        If lastDestCell Is Nothing Then
            destinationRow = 1
        Else
            destinationRow = lastDestCell.Row + 1
        End If
        
 
                ws.Range("A7:C70, F7:I70,K7:K70,D7:D70,L7:L70, DE7:EZ70").Copy
                ThisWorkbook.Sheets("BSum").Range("A" & destinationRow).PasteSpecial xlPasteValues
                ThisWorkbook.Sheets("BSum").Range("A" & destinationRow).PasteSpecial xlPasteFormats
                destinationRow = destinationRow + 1
        
        
      
        Application.ScreenUpdating = True
        Application.DisplayAlerts = False
        wb.Close
        MsgBox "Copy Complete"

    End If
    

'Add date ran

   Sheets("BSum").Range("F1").Value = Date
   Application.Calculation = xlCalculationAutomatic

    
     MsgBox "All Updates Complete"
   
End Sub

Open in new window

jmac001Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Glenn RayExcel VBA DeveloperCommented:
I presume the issue is with lines 72-74.  You will have to break up the copy and paste into six distinct sections if you want those copied ranges pasted in the listed order or in identical columns.  Using the Split function, one can create a loop through your source and destination ranges:

        Dim arrRanges, arrDestCol As Variant
        Dim x As Integer
        arrRanges = Split("A7:C70,F7:I70,K7:K70,D7:D70,L7:L70,DE7:EZ70", ",")
        arrDestCol = Split("A,D,H,I,J,K", ",")
        For x = 0 To UBound(arrRanges)
            ws.Range(arrRanges(x)).Copy
            ThisWorkbook.Sheets("BSum").Range(arrDestCol(x) & destinationrow).PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("BSum").Range(arrDestCol(x) & destinationrow).PasteSpecial xlPasteFormats
        Next x
        destinationrow = destinationrow + 1

Open in new window


I couldn't test your code directly since the LastCell function was not included, but I presume it returns the last available cell to copy/paste data.

Regards,
-Glenn
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
jmac001Author Commented:
Thank you Glenn actually working the way I envisioned and has all of the correct columns
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.