Copy select cells from one sheet into the next available column in another sheet

**gsjan1** · 01-27-2012, 02:58 PM

I have data in several cells that are located in various spots within Sheet1(AMB). I have created a macro to copy these (with a Paste Special, Value function) into Sheet2(TREND) in one continuous column (see below). My question is - How can I write this macro so that each week it will copy this information into the next available column? So, next week's data will be dumped into Column C, then week 3 gets dumped into column D, etc. The cell locations in Worksheet 1 will always be the same and the Rows it gets dumped into in Worksheet 2 will always be the same. I just need the column to increment 1 each time the macro is run. I appreciate any help!

Sub Trend()
'
' Trend Macro
'
' Keyboard Shortcut: Ctrl+t
'
    Range("B5").Select
    Selection.Copy
    Sheets("Trend").Select
    Range("B5").Select
    ActiveSheet.Paste
    Sheets("AMB").Select
    Range("N11:N16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Trend").Select
    Range("B6:B11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("AMB").Select
    Range("I24").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Trend").Select
    Range("B12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("AMB").Select
    ActiveWindow.SmallScroll Down:=18
    Range("I32:I33").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Trend").Select
    Range("B13:B14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("AMB").Select
    ActiveWindow.ScrollRow = 20
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 22
    ActiveWindow.ScrollRow = 23
    ActiveWindow.ScrollRow = 24
    ActiveWindow.ScrollRow = 25
    Range("K41:K42").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Trend").Select
    Range("B15:B16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("AMB").Select
    Range("F49:F50").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Trend").Select
    Range("B17:B18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "m/d;@"
    Range("B6:B18").Select
    Selection.NumberFormat = "0.0%"
End Sub

**PaulMcF** · 01-27-2012, 05:45 PM

Hi gsjan1,

Use the "Trend" worksheet's UsedRange property to return the used portion of the sheet, count the number of columns in that range, and then use that number to offset your paste ranges.

First, add the following lines to calculate the offset:

    Dim nColOffset As Integer
    nColOffset = Sheets("Trend").UsedRange.Columns.Count

Now adjust the "Trend" sheet Select statements to include the offset. A couple of examples are shown in the following:


    Range("B5").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("B5").Offset(0, nColOffset).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("N11:N16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("B6:B11").Offset(0, nColOffset).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

I hope this helps.

Cheers,
Paul