VBA: Copy X Col to new sheet

harky

Active Member
Joined
Apr 8, 2010
Messages
313
I like to copy a marco to copy 'masterlist' sheet of X roll below

HOPE somone can help me :)

B16 C16E16H16Q16AD16R16S16T16U16V16W16X16Y16Z16AA16AB16AC16
to new wk

A2B2C2D2E2F2G2H2I2J2K2L2M2N2O2P2Q2R2

<tbody>
</tbody>
 

Some videos you may like

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

salim hasan

Board Regular
Joined
Dec 25, 2013
Messages
103
Try this simple Macro
Code:
Option Explicit


Sub Copy_columns()
Rem =====>>This is a simple example
Dim i%
Dim First_sh As Worksheet
Dim Sec_sh As Worksheet
Dim First_arr(), Sec_arr()
Set First_sh = Sheets("Sheet1") ' Change Sheet1 by the sheet's name of data source
Set Sec_sh = Sheets("Sheet2") ' Change Sheet2  by the sheet's name of data target
First_arr = Array("$B$4", "$c$6", "$e$1") 'Complete the array
Sec_arr = Array("$A$2", "$c$2", "$d$2") 'Complete the array
For i = LBound(Sec_arr) To UBound(Sec_arr)
 Sec_sh.Range(Sec_arr(i)) = First_sh.Range(First_arr(i))
 Next
End Sub
 
Last edited:

harky

Active Member
Joined
Apr 8, 2010
Messages
313
hi,
this isnt what i want.. i want to copy the WHOLE COLUMN. Start from B16 below

ur code only copy 1 row?


i want to copy COLUMN not row.


Try this simple Macro
Code:
Option Explicit


Sub Copy_columns()
Rem =====>>This is a simple example
Dim i%
Dim First_sh As Worksheet
Dim Sec_sh As Worksheet
Dim First_arr(), Sec_arr()
Set First_sh = Sheets("Sheet1") ' Change Sheet1 by the sheet's name of data source
Set Sec_sh = Sheets("Sheet2") ' Change Sheet2  by the sheet's name of data target
First_arr = Array("$B$4", "$c$6", "$e$1") 'Complete the array
Sec_arr = Array("$A$2", "$c$2", "$d$2") 'Complete the array
For i = LBound(Sec_arr) To UBound(Sec_arr)
 Sec_sh.Range(Sec_arr(i)) = First_sh.Range(First_arr(i))
 Next
End Sub
 
Last edited:

harky

Active Member
Joined
Apr 8, 2010
Messages
313
Hi,
I manage to get the code work myself :)


Code:
Sub Step1_CopyRange()
    Dim lr As Long
    
    Application.ScreenUpdating = False
    With Sheets("ad_hoc")        'Source worksheet name
    Set DestSh = Sheets("test")  'Destination worksheet name
    
    'START of confirmation message box'
    response = MsgBox("Run Macro?", vbYesNo)
    If response = vbNo Then
    MsgBox ("Macro Canceled!")
    Exit Sub
    End If
    'END of confirmation message box'
    
         lr = .Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
        
  'Ir = last column of x
        .Range(.Cells(17, "B"), .Cells(lr, "B")).Copy DestSh.Cells(4, "A")
        .Range(.Cells(17, "C"), .Cells(lr, "C")).Copy DestSh.Cells(4, "B")
        .Range(.Cells(17, "E"), .Cells(lr, "E")).Copy DestSh.Cells(4, "C")
        .Range(.Cells(17, "H"), .Cells(lr, "H")).Copy DestSh.Cells(4, "D")
        .Range(.Cells(17, "Q"), .Cells(lr, "Q")).Copy DestSh.Cells(4, "E")
        .Range(.Cells(17, "AD"), .Cells(lr, "AD")).Copy DestSh.Cells(4, "F")
        .Range(.Cells(17, "R"), .Cells(lr, "R")).Copy DestSh.Cells(4, "G")
        .Range(.Cells(17, "S"), .Cells(lr, "S")).Copy DestSh.Cells(4, "H")
        .Range(.Cells(17, "T"), .Cells(lr, "T")).Copy DestSh.Cells(4, "I")
        .Range(.Cells(17, "U"), .Cells(lr, "U")).Copy DestSh.Cells(4, "J")
        .Range(.Cells(17, "V"), .Cells(lr, "V")).Copy DestSh.Cells(4, "K")
        .Range(.Cells(17, "W"), .Cells(lr, "W")).Copy DestSh.Cells(4, "L")
        .Range(.Cells(17, "X"), .Cells(lr, "X")).Copy DestSh.Cells(4, "M")
        .Range(.Cells(17, "Y"), .Cells(lr, "Y")).Copy DestSh.Cells(4, "N")
        .Range(.Cells(17, "Z"), .Cells(lr, "Z")).Copy DestSh.Cells(4, "O")
        .Range(.Cells(17, "AA"), .Cells(lr, "AA")).Copy DestSh.Cells(4, "P")
        .Range(.Cells(17, "AB"), .Cells(lr, "AB")).Copy DestSh.Cells(4, "Q")
        .Range(.Cells(17, "AC"), .Cells(lr, "AC")).Copy DestSh.Cells(4, "R")
        
    End With
    Application.ScreenUpdating = True
    
'START MSG'
      MsgBox "Copy Completed!"
      Exit Sub
 'End MSG'
 
End Sub
 
Last edited:

salim hasan

Board Regular
Joined
Dec 25, 2013
Messages
103
You can shorten the code to this
Code:
Option Explicit
Sub Copy_columns_Modified()
Rem =====>>This is a simple example
Dim i%, lr%
Dim First_sh As Worksheet
Dim Sec_sh As Worksheet
Dim First_arr(), Sec_arr()


Set First_sh = Sheets("Sheet1") ' Change Sheet1 by the sheet's name of data source
Set Sec_sh = Sheets("Sheet2") ' Change Sheet2  by the sheet's name of data target
lr = First_sh.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row


First_arr = Array("B", "E", "H", "Q") 'Complete the array
Sec_arr = Array("A", "B", "C", "D") 'Complete the array


For i = LBound(Sec_arr) To UBound(Sec_arr)
 First_sh.Cells(17, First_arr(i)).Resize(lr).Copy _
  Sec_sh.Cells(4, Sec_arr(i))
 Next
End Sub
 

harky

Active Member
Joined
Apr 8, 2010
Messages
313
This work great but how to Copy and paste special value?

You can shorten the code to this
Code:
Option Explicit
Sub Copy_columns_Modified()
Rem =====>>This is a simple example
Dim i%, lr%
Dim First_sh As Worksheet
Dim Sec_sh As Worksheet
Dim First_arr(), Sec_arr()


Set First_sh = Sheets("Sheet1") ' Change Sheet1 by the sheet's name of data source
Set Sec_sh = Sheets("Sheet2") ' Change Sheet2  by the sheet's name of data target
lr = First_sh.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row


First_arr = Array("B", "E", "H", "Q") 'Complete the array
Sec_arr = Array("A", "B", "C", "D") 'Complete the array


For i = LBound(Sec_arr) To UBound(Sec_arr)
 First_sh.Cells(17, First_arr(i)).Resize(lr).Copy _
  Sec_sh.Cells(4, Sec_arr(i))
 Next
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,102,049
Messages
5,484,401
Members
407,438
Latest member
DKrakken

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top