Migrating data from one workbook to other. In new workbook I want only specific columns (that are almost 250). As the data in Master file, is inconsistent and not in same range, so how can I extract those 250 columns? As, I am new to VBA, I have tried the code below, it's working but I have to write long code for all that 250 columns? Any help will be greatly appreciated.
Sub Data_Migration()
Dim y As Workbook
Dim x As Workbook
Dim ws As Worksheet
Dim sh As Worksheet
Dim rng As Range
Set y = ThisWorkbook
Application.ScreenUpdating = 0
Set x = Workbooks.Open("file path")
'Column Q from master file with worksheet name cba is copied in new workbook with sheet name abc and pasted in column D
Set ws = y.Sheets("abc")
Set sh = x.Sheets("cba")
Set rng = sh.Range("Q2:Q11443")
rng.Copy
y.Sheets("abc").Range("D1").PasteSpecial xlValues
Application.CutCopyMode = False
Set ws = y.Sheets("abc")
Set sh = x.Sheets("cba")
Set rng = sh.Range("Z2:Z11443")
rng.Copy
y.Sheets("abc").Range("E1").PasteSpecial xlValues
Application.CutCopyMode = False
Set ws = y.Sheets("abc")
Set sh = x.Sheets("cba")
Set rng = sh.Range("AI2:AI11443")
rng.Copy
y.Sheets("abc").Range("F1").PasteSpecial xlValues
Application.CutCopyMode = False
x.Close
End sub
Paste the following code into a standard code module (by default 'Module1' but you can name it to your liking).
Sub Main()
' 21 Mar 2017
Dim WsS As Worksheet ' S = Source
Dim WbT As Workbook, WsT As Worksheet ' T = Target
Dim Cs As Long, Ct As Long ' Column numbers: Source & Target
Dim Clms As Variant
Dim i As Integer ' index for Clms
Application.ScreenUpdating = False
On Error GoTo ErrExit
' Source is the first worksheet in the active workbook:
Set WsS = ActiveWorkbook.Worksheets("Haseev")
Set WbT = Workbooks.Add(xlWBATWorksheet)
Set WsT = WbT.Worksheets(1)
WsT.Name = "Extract 250" 'name the target sheet
Clms = Array(1, 4, 8, 13) ' list column numbers < 17
For i = 0 To UBound(Clms)
CopyColumn WsS, WsT, Clms(i), Ct
Next i
For Cs = 17 To Columns("CHU").Column Step 9
CopyColumn WsS, WsT, Cs, Ct
'''' If Ct > 10 Then Exit For
Next Cs
ErrExit:
Application.ScreenUpdating = True
End Sub
Understand the code:- Make the currently active workbook the "Source", meaning you must look at the workbook from which you are about to copy data. The code expects to find a worksheet by the name of "Haseev" in this workbook. Change the name in the code or change that entire line of code to
Set WsS = ActiveWorkbook.Worksheets(1)
That specifies the first worksheet in the workbook which makes good sense because a large workbook like yours isn't likely to have too many sheets.
The code will create a new workbook with a single sheet in it. It will name that sheet "Extract 250". Change the name in the code to something you prefer. Next, the code will copy selected columns to the new workbook.
Clms = Array(1, 4, 8, 13)
You can specify which columns you want to copy - as many as you need, numbers separated by commas. If you don't want any, just leave the specification blank, like Clms = Array()
In the next loop every 9th column is copied, starting from column 17 to column "CHU". You can modify the "CHU". The line
'''' If Ct > 10 Then Exit For
is a leftover from my testing. You may like to use it for the same purpose. Remove the apostrophes which disable the code and the loop will stop copying after 10 columns have been copied to the new workbook.
You may notice that the above code doesn't contain any copy or paste. Instead, it calls the next sub which you should paste below the Main procedure you already copied above.
Private Sub CopyColumn(WsS As Worksheet, _
WsT As Worksheet, _
ByVal Cs As Long, _
Ct As Long)
' 21 Mar 2017
' Ct is a return Long
If Cs > 0 Then ' column number must be > 0
Ct = Ct + 1
WsS.Columns(Cs).Copy Destination:=WsT.Columns(Ct)
End If
End Sub
Basically, the Main procedure just manages the 250 plus times this sub will be called.
The output workbook will have a generic name given by Excel, like "Sheet1". You can save it under any name you wish or close it and make a new one next time you wish to look at it.