Copy several columns into a specific range (new workbook)

[Barrigudo]

Hi there,

I have been lately working with VBA and I got stuck, selecting the data I am interested in and copy it into a new workbook. I have seen examples and youtube videos but I have clearly missed something.

I have posted part of the code, as the rest is working fine:

Private Sub Obtain_Data_Click()

    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim SelectedFiles() As Variant
    Dim NRow As Long
    Dim FileName As String
    Dim NFile As Long
    Dim ThisWorkbook As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range
    Dim i As Integer
    
    Dim lastrow As Long, lastcolumn As Long
    
    
    
    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    
    ' Modify this folder path to point to the files you want to use.
    FolderPath = "C:\Users\Mark\Desktop\PV Data"
    
    
              
              
    ' Set the current directory to the the folder path.
    ChDrive FolderPath
    ChDir FolderPath
    
    ' Open the file dialog box and filter on Excel files, allowing multiple files
    ' to be selected.
    SelectedFiles = Application.GetOpenFilename( _
        filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
    
    ' NRow keeps track of where to insert new rows in the destination workbook.
    NRow = 1
    
    ' Loop through the list of returned file names
    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        ' Set FileName to be the current workbook file name to open.
        FileName = SelectedFiles(NFile)
        
        ' Open the current workbook.
        Set ThisWorkbook = Workbooks.Open(FileName)
        
        'Copy column A
        
        Dim sh1 As Worksheet, sh2 As Worksheet, p As Long
    Dim j As Long, N As Long, r1 As Range

    Set sh1 = ThisWorkbook.Sheets("Sheet1")
    Set sh2 = SummarySheet
    N = sh1.Cells(Rows.Count, "A").End(xlUp).Row
    j = p

    For p = 1 To N
        Set r1 = sh1.Cells(p, "A")
        If r1.Value <> "" Then
            r1.Copy sh2.Cells(j, "A")
            j = j + p
        End If
    Next p

 'Copy column A
        
        Dim sh1 As Worksheet, sh2 As Worksheet, p As Long
    Dim j As Long, N As Long, r1 As Range

    Set sh1 = ThisWorkbook.Sheets("Sheet1")
    Set sh2 = SummarySheet
    N = sh1.Cells(Rows.Count, "A").End(xlUp).Row
    j = p

    For p = 1 To N
        Set r1 = sh1.Cells(p, "A")
        If r1.Value <> "" Then
            r1.Copy sh2.Cells(j, "A")
            j = j + p
        End If
    Next p



' Set the cell in column F2 to be the file name.
        SummarySheet.Range("A2").Value = ActiveWorkbook.Name
        
        
      
          SummarySheet.Range("A1").Value = "Name of the Site"

Basically I want to copy several (but not all) columns from the opened file, into specific columns inside the new workbook.

Any help is highly appreciated

Many Thanks

Ricardo

[joe31623]

I eliminated some duplicate declarations (and duplicate code), moved your declarations up to the top, and re-wrote the portion of the code that copies columns to use .Resize and (...).Cells.Value = r1.Cells.Value methods instead of the .copy method. I did not add any variables and I tried to leave most of your code b/f the copy attempt was made.

If at all possible, avoid the .copy method unless you want to copy over formatting and don't want to spend time to write additional code to carry over the formatting. It's orders of magnitude slower.

Private Sub Obtain_Data_Click()
    Dim sh1 As Worksheet, sh2 As Worksheet, p As Long
    Dim j As Long, N As Long, r1 As Range
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim SelectedFiles() As Variant
    Dim NRow As Long
    Dim FileName As String
    Dim NFile As Long
    Dim ThisWorkbook As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range
    Dim i As Integer
    
    Dim lastrow As Long, lastcolumn As Long
    
    
    
    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    
    ' Modify this folder path to point to the files you want to use.
    FolderPath = "C:\Users\Mark\Desktop\PV Data"
    
    
              
              
    ' Set the current directory to the the folder path.
    ChDrive FolderPath
    ChDir FolderPath
    
    ' Open the file dialog box and filter on Excel files, allowing multiple files
    ' to be selected.
    SelectedFiles = Application.GetOpenFilename( _
        filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
    
    ' NRow keeps track of where to insert new rows in the destination workbook.
    NRow = 1
    
    ' Loop through the list of returned file names
    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        ' Set FileName to be the current workbook file name to open.
        FileName = SelectedFiles(NFile)
        
        ' Open the current workbook.
        Set ThisWorkbook = Workbooks.Open(FileName)
        
        'Copy column A
        


    Set sh1 = ThisWorkbook.Sheets("Sheet1")
    Set sh2 = SummarySheet
    N = sh1.Cells(sh1.Rows.Count, "A").End(xlUp).Row

    'Copy column A into next blank cell on the summarysheet
    Set r1 = sh1.Range(sh1.Cells(1, "A").Address).Resize(N, 1)
    If sh2.Cells(1, 1).Value = Empty Then
        sh2.Range(sh2.Cells(1, 1).Address).Resize(r1.Rows.Count, 1).Cells.Value = r1.Cells.Value
    Else
        sh2.Range(sh2.Range(sh2.Cells(1, sh2.Columns.Count).End(xlToLeft).Column + 1).Address).Resize(r1.Rows.Count, 1).Cells.Value = r1.Cells.Value
    End If


' Set the cell in column F2 to be the file name.
        SummarySheet.Range("A2").Value = ActiveWorkbook.Name
        
        
      
          SummarySheet.Range("A1").Value = "Name of the Site"


Next NFile
End Sub

...it compiles -- but I had to add a "Next NFile" because it looks like this is only an excerpt from your code.

Hope this helps.

[Barrigudo]

Thanks for the quick reply,

In fact, I tried to improve the code, by using more ranges to capture several columns, but somehow the data copied from these ranges never reaches the new workbook and most of the transmission is lost, being able to insert the last headers only:

Option Explicit

Private Sub Obtain_Data_Click()


    
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim SelectedFiles() As Variant
    Dim NRow As Long, NRow2 As Long, NRow3 As Long, NRow4 As Long, NRow5 As Long
    Dim FileName As String
    Dim NFile As Long
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range, DestRange2 As Range, DestRange3 As Range, DestRange4 As Range, DestRange5 As Range
    Dim i As Integer
    Dim SourceRange2 As Range, SourceRange3 As Range, SourceRange4 As Range, SourceRange5 As Range
        
    Dim lastrow As Long, lastcolumn As Long
    
    
    
    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    
    ' Modify this folder path to point to the files you want to use.
    FolderPath = "C:\Users\Mark\Desktop\PV Data"
    
    
              
              
    ' Set the current directory to the the folder path.
    ChDrive FolderPath
    ChDir FolderPath
    
    ' Open the file dialog box and filter on Excel files, allowing multiple files
    ' to be selected.
    SelectedFiles = Application.GetOpenFilename( _
        filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
    
    ' NRow keeps track of where to insert new rows in the destination workbook.
    NRow = 1
    NRow2 = 1
    NRow3 = 1
    NRow4 = 1
    NRow5 = 1
    
    ' Loop through the list of returned file names
    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        ' Set FileName to be the current workbook file name to open.
        FileName = SelectedFiles(NFile)
        
        ' Open the current workbook.
        Set WorkBk = Workbooks.Open(FileName)
        
        'Set where to get data from
        
        
        'column A, for Date
        
        
        Set SourceRange = WorkBk.Worksheets(1).Range("A:A")
        
        
        ' Set the destination range to start at column B and be the same size as the source range.
        Set DestRange = SummarySheet.Range("C" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
           SourceRange.Columns.Count)
           
        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value
        
        ' Increase NRow so that we know where to copy data next.
        NRow = NRow + DestRange.Rows.Count
        
        
'Column B Irradiance Horizontal
Set SourceRange2 = WorkBk.Worksheets(1).Range("B:B")
        
        
        ' Set the destination range to start at column B and be the same size as the source range.
        Set DestRange2 = SummarySheet.Range("D" & NRow2)
        Set DestRange2 = DestRange2.Resize(SourceRange2.Rows.Count, _
           SourceRange2.Columns.Count)
           
        ' Copy over the values from the source to the destination.
        DestRange2.Value = SourceRange2.Value
        
        ' Increase NRow so that we know where to copy data next.
        NRow2 = NRow2 + DestRange2.Rows.Count
        
'column N Irradiance Tilted


        Set SourceRange3 = WorkBk.Worksheets(1).Range("N:N")
        

        ' Set the destination range to start at column B and be the same size as the source range.
        Set DestRange3 = SummarySheet.Range("E" & NRow3)
        Set DestRange3 = DestRange3.Resize(SourceRange3.Rows.Count, _
           SourceRange3.Columns.Count)
           
        ' Copy over the values from the source to the destination.
        DestRange3.Value = SourceRange3.Value
        
        ' Increase NRow so that we know where to copy data next.
        NRow3 = NRow3 + DestRange3.Rows.Count

'column X Rated PV

Set SourceRange4 = WorkBk.Worksheets(1).Range("X:X")
        
        
        ' Set the destination range to start at column B and be the same size as the source range.
        Set DestRange4 = SummarySheet.Range("F" & NRow4)
        Set DestRange4 = DestRange4.Resize(SourceRange4.Rows.Count, _
           SourceRange4.Columns.Count)
           
        ' Copy over the values from the source to the destination.
        DestRange4.Value = SourceRange4.Value
        
        ' Increase NRow so that we know where to copy data next.
        NRow4 = NRow4 + DestRange4.Rows.Count
       
           
  'column G Energy Delivered to the Grid

Set SourceRange5 = WorkBk.Worksheets(1).Range("G:G")
        
        ' Set the destination range to start at column B and be the same size as the source range.
        Set DestRange5 = SummarySheet.Range("I" & NRow5)
        Set DestRange5 = DestRange5.Resize(SourceRange5.Rows.Count, _
           SourceRange5.Columns.Count)
           
        ' Copy over the values from the source to the destination.
        DestRange5.Value = SourceRange5.Value
        
        ' Increase NRow so that we know where to copy data next.
        NRow5 = NRow5 + DestRange5.Rows.Count
        
        
        
        SummarySheet.Range("A1").Value = "Name of the Site"
        
       ' Set the cell in column F2 to be the file name.
        SummarySheet.Range("A2").Value = WorkBk.Name
          
             
              
              SummarySheet.Range("D1") = "Irradiance (GHI)"
              SummarySheet.Range("E1") = "Tilted Irradiance"
              SummarySheet.Range("F1") = "Rated PV Energy"
              SummarySheet.Range("G1") = "Calculated PV Energy (exc. Reflection losses)"
              SummarySheet.Range("H1") = "Energy To The Grid"
              SummarySheet.Range("I1") = "Projected PR"
              SummarySheet.Range("J1") = "Calculated PR"
              SummarySheet.Range("K1") = "Area of the Site in m2"
              SummarySheet.Range("L1") = "Panel Efficiency in %"

        
          
     
       
    Next NFile
    
   ' Call AutoFit on the destination sheet so that all data is readable.
    SummarySheet.Columns.AutoFit




End Sub

I think this method is better, but no clue what kind of mistake I am doing, as the program runs without errors.

Thanks for your patience

[MarvinP]

Hi Ricardo and welcome to the forum,

I can do your problem without needing any VBA in about 10 mouse clicks. Here is how......

Excel realized a few version ago that users wanted to import all kinds of data into Excel. They created a tool they call now Power Query. I have it built into my 2016 version of Excel and if you don't have it you can download it for your version.

Power query is like a pre-processor of data from other file types. Here is how I'd do you problem:

1. Open a new and blank Excel Workbook
2. In 2016 I click on the Data Tab and then the "New Query" dropdown.
3. Select From File -> From Workbook
4. This shows a dialog to pick the file I want to import the columns from. Select the file and click the Import button.
5. You will see a dialog asking which sheet(s) you want to import columns from. Select a sheet.
6. Now click on the EDIT button on the lower right of this "Navigator Dialog Screen"
7. Click on the Column Headings you want to import, until they are all selected.
8. Right click on any of the selected column heads and then on "Remove Other Columns"
9. Click on the "Close & Load" icon in this window.

DONE!!!! No VBA needed as I used Power Query to import columns from another workbook.

Read more about it at:
https://support.office.com/en-us/art...5-89F6269CD605

[Barrigudo]

Thanks a lot Marvin.

I will take a look into that new way of transferring data

Cheers