Hard Code VBA code to improve

S

suresh ullanki

Board Regular
Joined
Apr 29, 2013
Messages
67
Hi,

I need to copy specific columns and paste into another workbook. I have written VBA code which is working fine. However, I was asked to make prompt as it has been hard coded. Can any one help with better way to achieve this.

Sub copycolumns60()
Dim lastrow As Long
Dim wkb2 As Workbook
Dim wkb As Workbook
Set wkb2 = ThisWorkbook
Set wkb = Workbooks.Open("C:\users\su\desktop\Book2.xlsx") ' Will add new workbook
lastrow = ThisWorkbook.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
' with column name
ThisWorkbook.Sheets("Sheet1").Range("A2:A" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("A2")
ThisWorkbook.Sheets("Sheet1").Range("b2:b" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("b2")
ThisWorkbook.Sheets("Sheet1").Range("c2:c" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("c2")
ThisWorkbook.Sheets("Sheet1").Range("d2:d" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("d2")
ThisWorkbook.Sheets("Sheet1").Range("e2:e" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("e2")
ThisWorkbook.Sheets("Sheet1").Range("f2:f" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("f2")
ThisWorkbook.Sheets("Sheet1").Range("g2:g" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("g2")
ThisWorkbook.Sheets("Sheet1").Range("h2:h" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("h2")
ThisWorkbook.Sheets("Sheet1").Range("i2:i" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("i2")
ThisWorkbook.Sheets("Sheet1").Range("j2:j" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("j2")
ThisWorkbook.Sheets("Sheet1").Range("k2:k" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("k2")
ThisWorkbook.Sheets("Sheet1").Range("l2:l" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("l2")
ThisWorkbook.Sheets("Sheet1").Range("m2:m" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("m2")
ThisWorkbook.Sheets("Sheet1").Range("r2:r" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("n2")
ThisWorkbook.Sheets("Sheet1").Range("s2:s" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("o2")
ThisWorkbook.Sheets("Sheet1").Range("v2:v" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("p2")
ThisWorkbook.Sheets("Sheet1").Range("w2:w" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("q2")
ThisWorkbook.Sheets("Sheet1").Range("x2:x" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("r2")
ThisWorkbook.Sheets("Sheet1").Range("y2:y" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("s2")
ThisWorkbook.Sheets("Sheet1").Range("z2:z" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("t2")
ThisWorkbook.Sheets("Sheet1").Range("aa2:aa" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("u2")
ThisWorkbook.Sheets("Sheet1").Range("ab2:ab" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("v2")
ThisWorkbook.Sheets("Sheet1").Range("ac2:ac" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("w2")
ThisWorkbook.Sheets("Sheet1").Range("ad2:ad" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("x2")
ThisWorkbook.Sheets("Sheet1").Range("ae2:ae" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("y2")
ThisWorkbook.Sheets("Sheet1").Range("af2:af" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("z2")
ThisWorkbook.Sheets("Sheet1").Range("ag2:ag" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("aa2")
ThisWorkbook.Sheets("Sheet1").Range("ah2:ah" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("ab2")
ThisWorkbook.Sheets("Sheet1").Range("ai2:ai" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("ac2")
ThisWorkbook.Sheets("Sheet1").Range("aj2:aj" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("ad2")
ThisWorkbook.Sheets("Sheet1").Range("ak2:ak" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("ae2")
ThisWorkbook.Sheets("Sheet1").Range("al2:al" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("af2")
ThisWorkbook.Sheets("Sheet1").Range("am2:am" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("ag2")
ThisWorkbook.Sheets("Sheet1").Range("an2:an" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("ah2")
ThisWorkbook.Sheets("Sheet1").Range("ao2:ao" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("ai2")
ThisWorkbook.Sheets("Sheet1").Range("ap2:ap" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("aj2")
ThisWorkbook.Sheets("Sheet1").Range("aq2:aq" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("ak2")
ThisWorkbook.Sheets("Sheet1").Range("at2:at" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("al2")
ThisWorkbook.Sheets("Sheet1").Range("au2:au" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("am2")
ThisWorkbook.Sheets("Sheet1").Range("av2:av" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("an2")
ThisWorkbook.Sheets("Sheet1").Range("aw2:aw" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("ao2")
ThisWorkbook.Sheets("Sheet1").Range("ax2:ax" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("ap2")
ThisWorkbook.Sheets("Sheet1").Range("ay2:ay" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("aq2")
ThisWorkbook.Sheets("Sheet1").Range("az2:az" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("ar2")
ThisWorkbook.Sheets("Sheet1").Range("bq2:bq" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("as2")
ThisWorkbook.Sheets("Sheet1").Range("br2:br" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("at2")
ThisWorkbook.Sheets("Sheet1").Range("ba2:ba" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("au2")
ThisWorkbook.Sheets("Sheet1").Range("bb2:bb" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("av2")
ThisWorkbook.Sheets("Sheet1").Range("bc2:bc" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("aw2")
ThisWorkbook.Sheets("Sheet1").Range("bd2:bd" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("ax2")
ThisWorkbook.Sheets("Sheet1").Range("be2:be" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("ay2")
ThisWorkbook.Sheets("Sheet1").Range("bf2:bf" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("az2")
ThisWorkbook.Sheets("Sheet1").Range("bg2:bg" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("ba2")
ThisWorkbook.Sheets("Sheet1").Range("bh2:bh" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("bb2")
ThisWorkbook.Sheets("Sheet1").Range("bi2:bi" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("bc2")
ThisWorkbook.Sheets("Sheet1").Range("bj2:bj" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("bd2")
ThisWorkbook.Sheets("Sheet1").Range("bk2:bk" & lastrow).Copy Destination:=wkb.Sheets("Headcount Reg").Range("be2")
End Sub
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Sort by date Sort by votes
Hello Suresh, see if this will work for you. I'm pretty sure I got all the offsets correct, but you'll want to step through this carefully a couple times in a test worksheet before using it in a live version. It's possible to accomplish this faster if you use some resizing methods, but your copy columns and destinations seem really specific, so this might be a simpler way to do it.

Code: 
Sub copycolumns60()
    Dim lastrow As Long, wkb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Dim i As Long
    
    Set ws2 = ThisWorkbook.Sheets("Sheet1")
    Set wkb = Workbooks.Open("C:\users\su\desktop\Book2.xlsx")
    Set ws1 = wkb.Sheets("Headcount Reg")
    
    Application.ScreenUpdating = False
    lastrow = ws2.Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 1 To ws2.UsedRange.Columns.Count 'This can be changed to 70 if there are columns after BQ that are not copied.
        Select Case i
            Case Is <= 13
                Range(ws2.Cells(2, i), ws2.Cells(lastrow, i)).Copy Destination:=ws1.Cells(2, i)
            Case 18 To 19
                Range(ws2.Cells(2, i), ws2.Cells(lastrow, i)).Copy Destination:=ws1.Cells(2, i - 4)
            Case 22 To 43, 53 To 63
                Range(ws2.Cells(2, i), ws2.Cells(lastrow, i)).Copy Destination:=ws1.Cells(2, i - 6)
            Case 46 To 52
                Range(ws2.Cells(2, i), ws2.Cells(lastrow, i)).Copy Destination:=ws1.Cells(2, i - 8)
            Case 69 To 70
                Range(ws2.Cells(2, i), ws2.Cells(lastrow, i)).Copy Destination:=ws1.Cells(2, i - 24)
        End Select
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question Question
Dropdown code VBA doesn't execute
Replies
0
Views
504
niresh28
N
D
  • Question Question
Very minor change in code had a dramatic impact on the speed. Why?
Replies
2
Views
806
deZine
D
WildBurrow
  • Question Question
Paste data from select columns after applying auto filter
Replies
0
Views
497
WildBurrow
WildBurrow
V
  • Question Question
VBA memory error
Replies
5
Views
951
Joe4
Joe4
cmschmitz24
  • Question Question
Need Excel VBA to move multiple rows into 1 row
Replies
0
Views
448
cmschmitz24
cmschmitz24

Forum statistics

Threads
1,223,909
Messages
6,175,315
Members
452,634
Latest member
cpostell

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top