To copy specific columns from a raw file to another workbook

[ell_]

Hi, all

I have these 2 Excel files, one with raw data in sheet All_DTE and the file path: Z:\RSE-ROC-Public\RSE-OPM\COE Monthly Reporting\RSE COE Report\MID File.xslx & another one is the workbook where this code will run from, called Report, in DTE_Raw sheet.

In this raw file, there are a lot of data but I only want data from specific columns to be copied and pasted to Report file, in DTE_Raw sheet and the sequences of columns are as below:

column N to column A
column AE to column B
column AM to column C
column AN to column D
column BE to column E
column CP to column F
column CV to column G

The data that will be pasted may overwrite the previous data in the DTE_Raw sheet.

Here's the code that I have created but not working.


Option Explicit
Sub GenerateBook()
On Error GoTo OpenWorkBook:
Dim BookName As String
BookName = "RSE MID"
Workbooks("RSE MID Input File 2018").Activate
GenerateReport2
Exit Sub

OpenWorkBook:
If Err.Number = 9 Then
'change file path here
Workbooks.Open Filename:="Z:\RSE-ROC-Public\RSE-OPM\COE Monthly Reporting\RSE COE Report\RSE MID Input File 2018.xlsx"
Resume
End If
GenerateReport2
End Sub
Sub GenerateReport2()
Application.ScreenUpdating = False
Workbooks("RSE MID Input File 2018").Sheets("Raw data (DTE)").Select
Range("N1:N2000,AE1:AE2000,AM1:AM2000,AN1:AN2000,BE1:BE2000,CP1:CP2000,CV1:CV2000").Select
Selection.Copy
Sheets("DTE_Raw").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


Can anyone assist me in this? I have attached Excel files for reference. Thanks in advance for your help!

[Leith Ross]

Hello ell_,

This is macro I added to "Report". It worked for me. The attached workbook has the macro installed and button on "DTE_Raw" to run it.


Sub ImportRawData()


Dim c As Long
Dim Col As Variant
Dim Filename As String
Dim Filepath As Variant
Dim rngBeg As Range
Dim rngEnd As Range
Dim rngDst As Range
Dim rngSrc As Range
Dim rowsize As Long
Dim wkbDst As Workbook
Dim wkbSrc As Workbook

Set wkbDst = ThisWorkbook
Set rngDst = wkbDst.Worksheets("DTE_Raw").Range("A2:G2")

Filepath = "Z:\RSE-ROC-Public\RSE-OPM\COE Monthly Reporting\RSE COE Report"
Filename = "MID file.xlsx"

On Error Resume Next
Set wkbSrc = Workbooks(Filename)
If Err = 9 Then
If Filepath <> "" Then ChDir Filepath Else ChDir ThisWorkbook.Path
Filename = Application.GetOpenFilename("Excel Workbooks, *.xlsx")
If Filename = "False" Then Exit Sub
Set wkbSrc = Workbooks.Open(Filename)
End If
On Error GoTo 0

' Clear previous data.
rngDst.Resize(rngDst.Parent.UsedRange.Rows.Count).ClearContents

' Import the data.
With wkbSrc.Worksheets("All_DTE").UsedRange
' Step through the source data columns.
For Each Col In Array("N", "AE", "AM", "AN", "BE", "CP", "CV")
' Data starts on row 2.
Set rngBeg = .Parent.Cells(2, Col)

' Find the row where the data ends in this column.
Set rngEnd = .Parent.Cells(Rows.Count, Col).End(xlUp)

' Number of rows in this column.
rowsize = rngEnd.Row - rngBeg.Row

If rowsize > 0 Then
Set rngSrc = .Parent.Range(rngBeg, rngEnd)
rngDst.Offset(0, c).Resize(rowsize, 1).Value = rngSrc.Value
End If

' Increment the column offset.
c = c + 1
Next Col
End With

End Sub

[ell_]

Hi, Leith!


First of all, thank you so much for your time. Really appreciate that. I have tried the code and it works fine.

But I notice that it does not copy pasting the data after row 431 (I tried adding new data). May I know why?


This is my code after alteration:


Dim c As Long
Dim Col As Variant
Dim Filename As String
Dim Filepath As Variant
Dim rngBeg As Range
Dim rngEnd As Range
Dim rngDst As Range
Dim rngSrc As Range
Dim rowsize As Long
Dim wkbDst As Workbook
Dim wkbSrc As Workbook

Set wkbDst = ThisWorkbook
Set rngDst = wkbDst.Worksheets("DTE_Raw").Range("A2:G2")

Filepath = "Z:\RSE-ROC-Public\RSE-OPM\COE Monthly Reporting\RSE COE Report"
Filename = "RSE MID Input File 2018.xlsx"

On Error Resume Next
Set wkbSrc = Workbooks(Filename)
If Err = 9 Then
If Filepath <> "" Then ChDir Filepath Else ChDir ThisWorkbook.Path
Filename = Application.GetOpenFilename("RSE MID Input File 2018.xlsx")
If Filename = "False" Then Exit Sub
Set wkbSrc = Workbooks.Open(Filename)
End If
On Error GoTo 0

' Clear previous data.
rngDst.Resize(rngDst.Parent.UsedRange.Rows.Count).ClearContents

' Import the data.
With wkbSrc.Worksheets("Raw data (DTE)").UsedRange
' Step through the source data columns.
For Each Col In Array("N", "AE", "AM", "AN", "BE", "CP", "CV")
' Data starts on row 2.
Set rngBeg = .Parent.Cells(2, Col)

' Find the row where the data ends in this column.
Set rngEnd = .Parent.Cells(Rows.Count, Col).End(xlUp)

' Number of rows in this column.
rowsize = rngEnd.Row - rngBeg.Row

If rowsize > 0 Then
Set rngSrc = .Parent.Range(rngBeg, rngEnd)
rngDst.Offset(0, c).Resize(rowsize, 1).Value = rngSrc.Value
End If

' Increment the column offset.
c = c + 1
Next Col
End With

wkbSrc.Close savechanges:=False

End Sub


In addition, out of curiosity, is there any other way for this code to work but without opening the raw file instead?

Thanks again for your time. Have a nice day!