Consulting

Results 1 to 2 of 2

Thread: Copying two ranges and transposing one of them

  1. #1
    VBAX Newbie
    Joined
    Jan 2018
    Posts
    2
    Location

    Copying two ranges and transposing one of them

    I am trying to copy range "A12:b" and transpose it while also copying range "C12:F" and not transposing it. This is the code I am trying to edit:

    Sub Consolidate()
    
    
    
    
    Dim fName As String, fPath As String, fPathDone As String
    Dim LR As Long, NR As Long
    Dim wbData As Workbook, wsMaster As Worksheet
    
    
    'Setup
        Application.ScreenUpdating = False  'speed up macro execution
        Application.EnableEvents = False    'turn off other macros for now
        Application.DisplayAlerts = False   'turn off system messages for now
        
        Set wsMaster = ThisWorkbook.Sheets("Master")    'sheet report is built into
    
    
    With wsMaster
        If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
            .UsedRange.Offset(1).EntireRow.Clear
            NR = 2
        Else
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1    'appends data to existing data
        End If
    
    
    'Path and filename (edit this section to suit)
        fPath = "C:\Users\me\Desktop\Test\"            'remember final \ in this string"
        fPathDone = fPath & "Imported\"     'remember final \ in this string
        On Error Resume Next
            MkDir fPathDone                 'creates the completed folder if missing
        On Error GoTo 0
        fName = Dir(fPath & "New BM Analysis 4.xlsm")        'listing of desired files, edit filter as desired
    
    
    'Import a sheet from found files
        Do While Len(fName) > 0
            If fName <> ThisWorkbook.Name Then              'don't reopen this file accidentally
                Set wbData = Workbooks.Open(fPath & fName)  'Open file
    
    
            'This is the section to customize, replace with your own action code as needed
                LR = Range("A" & Rows.Count).End(xlUp).Row  'Find last row
                wbData.ActiveSheet.Range("A12:F" & LR).Copy
                .Range("A" & NR).PasteSpecial xlPasteValues, Transpose:=True
                
                
                wbData.Close False                                'close file
                NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1  'Next row
               ' Name fPath & fName As fPathDone & fName           'move file to IMPORTED folder
            End If
            fName = Dir                                       'ready next filename
        Loop
    End With
    
    
    ErrorExit:    'Cleanup
        ActiveSheet.Columns.AutoFit
        Application.DisplayAlerts = True         'turn system alerts back on
        Application.EnableEvents = True          'turn other macros back on
        Application.ScreenUpdating = True        'refreshes the screen
    End Sub
    Is this possible to do? I have tried separating the ranges into two lines, but it will not compile

  2. #2
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    832
    Location
    U should be able to do them by separating them, U just can't put them in the same spot. HTH. Dave
    LR = Range("A" & Rows.Count).End(xlUp).Row 'Find last row
    wbData.ActiveSheet.Range("A12:B" & LR).Copy
    wbData.ActiveSheet.Range("A" & nr).PasteSpecial xlPasteValues, Transpose:=True
    Application.CutCopyMode = False
    wbData.ActiveSheet.Range("C12:F" & LR).Copy
    wbData.ActiveSheet.Range("A" & nr + 2).PasteSpecial xlPasteValues, Transpose:=False
    Application.CutCopyMode = False

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •