Solved

VBA Paste Column in Non-Sequential Order

Posted on 2014-10-14
2
699 Views
Last Modified: 2014-10-14
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

0
Comment
Question by:jmac001
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 
LVL 27

Accepted Solution

by:
Glenn Ray earned 500 total points
ID: 40380845
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
 

Author Closing Comment

by:jmac001
ID: 40380999
Thank you Glenn actually working the way I envisioned and has all of the correct columns
0

Featured Post

PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes a serious pitfall that can happen when deleting shapes using VBA.
This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

615 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question