Macro for copying columns

  • Thread starter Thread starter Wayne Burritt
  • Start date Start date
W

Wayne Burritt

Hi--I'd like to program a macro (or two) that does the following things:

First, I need to take a range of data (source data) in a column (C2:C39, see
below) and ADD it eactly as it is to another worksheet (archive). The
problem is I want the macro to add the data to a new column in the archive
worksheet. The macro I made -- which is below -- keeps adding it in the
same place in the archive worksheet. Plus, I want it to find the archive
worksheet and not the "next" one. There's also some formatting stuff, too.
See my attempt in Macro 1 below.

Second, I need another macro to copy the last entry in the archive worksheet
to another worksheet (archive horizontal) and then do some formatting. See
my attempt in Macro 2 below.

Thanks for any help! Wayne


MACRO 1:

Sub Trade_review()
'
' Trade_review Macro
' Macro recorded 8/14/2003 by WBurritt
'

'
Range("C2:C39").Select
Selection.Copy
ActiveSheet.Next.Select
Range("BC2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("BB40:BB58").Select
Application.CutCopyMode = False
Selection.Copy
Range("BC40").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.ClearContents
Range("BC2").Select
End Sub



MACRO 2:

Sub Trade_Review_2()
'
' Trade_Review_2 Macro
' Macro recorded 8/14/2003 by WBurritt
'

'
Range("BC2:BC58").Select
Selection.Copy
Sheets("Rev Rpt (H)").Select
Range("B52").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Sheets("Rev Rpt (V)").Select
Range("BC2").Select
End Sub
 
Hi Wayne

All in a module

Sub copy_1()
Dim sourceRange As Range
Dim destrange As Range
Dim Lc As Integer
Lc = Lastcol(Sheets("Sheet2")) + 1
Set sourceRange = Sheets("Sheet1").Range("C2:C39")
Set destrange = Sheets("Sheet2").Cells(1, Lc)
sourceRange.Copy destrange
End Sub

Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function


You can use the function Lastcol also to copy the last column to another sheet.

Try it first and post back if you need help.
I must put the kids in bed know.

for more code see
http://www.rondebruin.nl/copy1.htm
 
Hi Wayne

After the copy you can do this in copy_2()

With destrange.Resize(1, 57).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
 
Back
Top