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

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

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,778
Messages
5,488,826
Members
407,658
Latest member
Arias610

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top