Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

VBA Paste Column in Non-Sequential Order

Posted on 2014-10-14
2
Medium Priority
?
765 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
2 Comments
 
LVL 27

Accepted Solution

by:
Glenn Ray earned 2000 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

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

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

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
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.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa‚Ķ

916 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