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

**gsjan1** · 01-27-2012, 03:43 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

**jaslake** · 01-27-2012, 04:55 PM

Hi gsjan1
I've inserted into your code the code to do this

How can I write this macro so that each week it will copy this information into the next available column

I also took the liberty to rewrite the first several lines of your code. The code was obviously recorded which is absolutely fine. Recorded code, however, results in many unnecessary lines that can be edited out. You'll notice in the lines I rewrote, there's no selecting going on.

Try the code then try to rewrite the rest of it without selecting...just be sure to notice the . (dot) within the With...End With statements. This is critical to the success of the code. If you need further help, let me know.

Option Explicit

Sub Trend()
    Dim LC As Long
    Dim NC As Long
    ' Keyboard Shortcut: Ctrl+t

    Application.ScreenUpdating = False    'turn off screen flicker
    With Sheets("AMB")
        .Range("B5").Copy
    End With

    With Sheets("Trend")
        LC = .Range("XFD5").End(xlToLeft).Column
        If LC = 1 Then
            NC = LC + 1
        Else
            NC = LC + 1
        End If
        .Cells(5, NC).PasteSpecial Paste:=xlPasteAll
    End With

    With Sheets("AMB")
        .Range("N11:N16").Copy
    End With

    With Sheets("Trend")
        .Cells(6, NC).PasteSpecial Paste:=xlPasteAll
    End With

    Sheets("AMB").Select
    Range("I24").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Trend").Select
    '    Range("B12").Select
    Cells(12, NC).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
    Cells(13, NC).Select
    '    Range("B13:B14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Sheets("AMB").Select

    Range("K41:K42").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Trend").Select
    Cells(15, NC).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
    Cells(17, NC).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%"
    Application.ScreenUpdating = True
End Sub

**gsjan1** · 01-27-2012, 05:55 PM

Hi Jaslake,

Thank you so much for your kind reply! I just copied and pasted everything and when I run the macro I get the following error: "Ambiguous Name Detected: Trend". I'm trying to figure out why that might be. I am very much a novice with VBA, so maybe it's just something very basic. Thoughts?

Thanks much!

**gsjan1** · 01-27-2012, 06:11 PM

Hi there,

I got past the ambiguous name error - so I'm good there. I'm troubleshooting something else now (it isn't pasting values) - will give you a thumbs up when I've got it working good. Many thanks!

**gsjan1** · 01-27-2012, 06:17 PM

Jaslake - you are GENIUS! It's working!! I still have to rewrite those other lines to neaten it up and play with some formatting issues, but - it IS copying to the next column just like I needed. A big hurdle cleared. Many thanks!

**jaslake** · 01-27-2012, 06:03 PM

Hi gsjan1
This would suggest you have two procedures with the name "Trend". Perhaps you placed the code I posted in your existing module or into a new module but your old code is still out there intact. If this is the case do one of two things...either rename one of the procedures (to Trend1 for example) or comment out ALL the lines of your existing procedure.

Let me know how you make out.

**jaslake** · 01-27-2012, 06:43 PM

Hi gsjan1
Not a genius...far from it. Though there are some members of this Forum that truly are. You've benefited from what I've learned from them. Others will benefit from what you've learned from us.
Glad I could be of help. Good hunting...need further help, let me know.

**gsjan1** · 01-27-2012, 07:31 PM

Hey jaslake,

I do need more help! I'm all the way to the end and I want to format Rows 6:18 as a percentage format. Is there a way I can do this without having to type the "End-With" segment over and over? I'll attach the whole code - but you can go straight to the bottom.

Also - my next challenge would be - how difficult would it be to conditional format the newly copied column by comparing it to the previous column and coloring it red if the number is higher and green if the number is lower? If that can be accomplished, I will have reached macro nirvana!

Thanks for your help!

Sub Trend()
    Dim LC As Long
    Dim NC As Long
    ' Keyboard Shortcut: Ctrl+t

    Application.ScreenUpdating = False    'turn off screen flicker
    With Sheets("AMB")
        .Range("B5").Copy
    End With

    With Sheets("Trend")
        LC = .Range("XFD5").End(xlToLeft).Column
        If LC = 1 Then
            NC = LC + 1
        Else
            NC = LC + 1
        End If
        .Cells(5, NC).PasteSpecial Paste:=xlPasteValues
    End With

    With Sheets("AMB")
        .Range("N11:N16").Copy
    End With

    With Sheets("Trend")
        .Cells(6, NC).PasteSpecial Paste:=xlPasteValues
    End With
    
    With Sheets("AMB")
        .Range("I24").Copy
    End With
    
    With Sheets("Trend")
        .Cells(12, NC).PasteSpecial Paste:=xlPasteValues
    End With
    
    With Sheets("AMB")
        .Range("I32:I33").Copy
    End With
    
    With Sheets("Trend")
        .Cells(13, NC).PasteSpecial Paste:=xlPasteValues
    End With
    
    With Sheets("AMB")
        .Range("K41:K42").Copy
    End With
    
    With Sheets("Trend")
        .Cells(15, NC).PasteSpecial Paste:=xlPasteValues
    End With
    
    With Sheets("AMB")
        .Range("F49:F50").Copy
    End With
    
    With Sheets("Trend")
        .Cells(17, NC).PasteSpecial Paste:=xlPasteValues
    End With
        
    With Cells(5, NC)
        .NumberFormat = "m/d;@"
    End With
    
    With Cells(6, NC)
        .NumberFormat = "0.0%"
    End With
    
    Application.ScreenUpdating = True
End Sub

**jaslake** · 01-28-2012, 01:37 AM

Hi gsjan1
Let me look at this in the morning...too late tonight.

**jaslake** · 01-28-2012, 02:01 PM

Hi gsjan1

Try this code for both issues

Option Explicit
Sub Trend()
    Dim LC As Long
    Dim NC As Long
    Dim Rng As Range
    Dim cel As Range
    ' Keyboard Shortcut: Ctrl+t

    Application.ScreenUpdating = False    'turn off screen flicker
    With Sheets("AMB")
        .Range("B5").Copy
    End With

    With Sheets("Trend")
        LC = .Range("XFD5").End(xlToLeft).Column    'XFD for Excel 2007; IV for pre 2007
        If LC = 1 Then
            NC = LC + 1
        Else
            NC = LC + 1
        End If
        .Cells(5, NC).PasteSpecial Paste:=xlPasteValues
    End With

    With Sheets("AMB")
        .Range("N11:N16").Copy
    End With

    With Sheets("Trend")
        .Cells(6, NC).PasteSpecial Paste:=xlPasteValues
    End With

    With Sheets("AMB")
        .Range("I24").Copy
    End With

    With Sheets("Trend")
        .Cells(12, NC).PasteSpecial Paste:=xlPasteValues
    End With

    With Sheets("AMB")
        .Range("I32:I33").Copy
    End With

    With Sheets("Trend")
        .Cells(13, NC).PasteSpecial Paste:=xlPasteValues
    End With

    With Sheets("AMB")
        .Range("K41:K42").Copy
    End With

    With Sheets("Trend")
        .Cells(15, NC).PasteSpecial Paste:=xlPasteValues
    End With

    With Sheets("AMB")
        .Range("F49:F50").Copy
    End With

    With Sheets("Trend")
        .Cells(17, NC).PasteSpecial Paste:=xlPasteValues
    End With

    With Cells(5, NC)
        .NumberFormat = "m/d;@"
    End With

    Set Rng = Range(Cells(6, NC), Cells(18, NC))
    Rng.NumberFormat = "0.0%"
    For Each cel In Rng
        If Not NC > 2 Then
            Exit For
        Else
            If cel.Value < cel.Offset(0, -1).Value Then
                cel.Interior.Color = 5296274
            ElseIf cel.Value > cel.Offset(0, -1).Value Then
                cel.Interior.Color = 255
            End If
        End If
    Next cel
    Application.ScreenUpdating = True
End Sub

**gsjan1** · 01-30-2012, 06:02 PM

Hi Jaslake,

I will be forever indebted to you for helping to create this awesome tool - It works wonderfully! ...except...one last piece. I have a button on the AMB sheet for the user to activate the macro once they've entered their data. As the code is currently written, it formats the cells on the AMB page instead of the Trend page. I tried inserting further definition into the range, but it doesn't seem to like it as now I get an error stopping on that line (Application Defined or Object Defined error). If you can help me with this last piece of syntax, I'll be off and running. A zillion thanks to you!

With Sheets("Trend")
        .Cells(5, NC).NumberFormat = "m/d;@"
    End With
    
    Set Rng = Sheets("Trend").Range(Cells(6, NC), Cells(18, NC))
    Rng.NumberFormat = "0.0%"
    For Each Cel In Rng
        If Not NC > 2 Then
            Exit For
        Else
            If Cel.Value < Cel.Offset(0, -1).Value Then
                Cel.Interior.Color = 255
            ElseIf Cel.Value > Cel.Offset(0, -1).Value Then
                Cel.Interior.Color = 5296274
            End If
        End If
    Next Cel
                
    Application.ScreenUpdating = True
End Sub

**gsjan1** · 01-31-2012, 03:33 PM

Hey Jaslake,

I ended up starting another post and got the question answered. Thanks so much for your help. I'm all set now. I wish I could buy you a pop or something.

Peace,
Janet

**jaslake** · 01-31-2012, 03:36 PM

Hi gsjan1
Sorry, with all the Forum issues I failed to get yesterday's notification. Glad you got it resolved.

**gsjan1** · 01-31-2012, 04:18 PM

Hi there,

You're back! And so am I.

I thought the other solution had fixed it - I was in a rush to get to a meeting - but now that I am back and looking at it closely, it actually didn't fix it. Rats! So, I'm right back where I was before. Any suggestions?

**gsjan1** · 01-31-2012, 04:50 PM

Jees - Never mind! I went back and doublechecked the other solution and discovered a bit of "operator error" on my part. I missed a "dot". It DOES in fact work fine now. persnickity little dots...

**jaslake** · 01-31-2012, 05:55 PM

I've had a dot or two destroy my procedures. Great hunting.

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

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions