Excel VBA: copying ranges, single cells to another workbook

Question

I am working on a simple VBA code for several templates, all with the same structure. From these templates (name: "Workbook1" e.g.), from "Profile" worksheet I would like to copy several cells: F6-F11, D15, F15, H15 and K30-38 to another workbook ("Tracker", "Sheet1) always to the first free row starting from C2 then C3 and so on. Could you please help me with that? I have the code for opening the given file:

Option Explicit

Public Sub CopyData()

    Dim wb As Workbook
    Dim FileName As String

    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        If .Show Then
            FileName = .SelectedItems(1)
            Set wb = Workbooks.Open(FileName:=FileName)
            Workbooks("Workbook1").Worksheets("Profile").Range("F6:F11").Copy
            Workbooks("Tracker.xlsx").Worksheets("Sheet1").Range("C2").PasteSpecial Transpose:=True
            wb.Close SaveChanges:=False
            Set wb = Nothing
        End If
    End With

End Sub

[This is how to find the next free cell](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba). — BigBen, Feb 16 '21 at 15:10
There is quite a lot of workbooks. What is the name of the `wb` workbook? What is the name of the workbook containing this code? What do you need to be copied? Values, formulas, and/or formats? — VBasic2008, Feb 16 '21 at 15:19
The source of the data (where I want to copy from): Workbook1(workbook), Profile, F6-F11, D15, F15, H15 and K30-38 to Tracker(workbook) , Sheet1, first available row starting from column C — Domosz, Feb 16 '21 at 15:27
But what about workbook `wb`? Is it `Workbook1` or...? Is the code in a third workbook? — VBasic2008, Feb 16 '21 at 15:29

score 0 · Answer 1 · answered Feb 16 '21 at 16:10

Copy Non-Contiguous Range

Option Explicit

Sub copyData()

    ' Constants
    Const sRangesList As String = "F6:F11,D15,F15,H15,K30:K38"
    
    ' Source
    Dim FilePath As String
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        If .Show Then
            FilePath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    Dim swb As Workbook: Set swb = Workbooks.Open(FileName:=FilePath)
    Dim sws As Worksheet: Set sws = swb.Worksheets("Profile")
    Dim sRanges() As String: sRanges = Split(sRangesList, ",")
    
    ' Destination
    Dim dwb As Workbook: Set dwb = Workbooks("Tracker.xlsx")
    Dim dws As Worksheet: Set dws = dwb.Worksheets("Sheet1")
    Dim dInit As Range
    Set dInit = dws.Cells(dws.Rows.Count, "C").End(xlUp).Offset(1)
    Dim dCell As Range: Set dCell = dInit
    
    ' Copy/Paste
    Dim sRange As Range
    Dim n As Long
    Application.ScreenUpdating = False
    For n = 0 To UBound(sRanges)
        Set sRange = sws.Range(sRanges(n))
        sRange.Copy
        dCell.PasteSpecial Transpose:=True
        Set dCell = dCell.Offset(, sRange.Rows.Count)
    Next n
    
    ' Close/Save
    Application.CutCopyMode = False
    swb.Close SaveChanges:=False
    dws.Activate
    dInit.Offset(1).Activate
    'dwb.Save
    
End Sub

Thanks for your assistance, it worked! What if I change the Constants to Const sRangesList As String = "F6:F11,D15,F15,H15,K15,D16,F16,H16,K16,D17,F17,H17,K17,D18,F18,H18,K18,D19,F19,H19,K19,D21,F21,H21,J21,H23,D25,F25,H25,D26,H26,F26,D27,F27,H27,K30:K38,F40:F44" than should I change sthng in the destination as well? The sdestin ation is between C:BE — Domosz, Feb 16 '21 at 17:19
It should work as-is. Just be careful that the range addresses refer to columns, not rows. The only other limitation is the number of columns in a worksheet (16384). — VBasic2008, Feb 16 '21 at 17:57

Excel VBA: copying ranges, single cells to another workbook

1 Answers1

Copy Non-Contiguous Range