Copy Paste VBA

[RMXByker]

Good Morning Everyone,

I am working on my first VBA project here at work. I need the following.

Copy Data from Worksheet "WORKSHEET"
Range is ("B4:B33")

The data in this range are sum calculations. I only want to copy the value, not the calculation so a paste special seems to be needed.

Now onto where the values will be pasted to.

Worksheet "HRS BY WEEK"

Now comes the more difficult part for me...

I want the macro to look in cell range ("C5:C34"). If there is information there, go to ("D5:D34") and so forth. The first column within that range (5 to 34) that doesn't have information is going to be the paste location.


I thought this was going to be an easy VBA for me to be my first try but for some reason it just is not working for me. Any help is appreciated.

Thanks all,
RMXByker

 

[JackDanIce]

Try this:

Sub copyvalue()
Worksheets("Sheet1").Range("B4:B33").Copy
Worksheets("Sheet2").Select
'assuming you mean the first empy cell in row 5, starting from cell C5
Range("C5").Select
If IsEmpty(Range("C5")) Then
Else
    If IsEmpty(Range("D5")) Then
        Range("D5").Select
    Else
        Selection.End(xlToRight).Select
        Selection.Offset(0, 1).Select
    End If
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

 

[JackDanIce]

Try this, you can keep running this macro to copy and paste to the first blank column to the right of C5:

Sub copyvalue()
Worksheets("WORKSHEET").Range("B4:B33").Copy
Worksheets("HRS BY WEEK").Select
'assuming you mean the first empy cell in row 5, starting from cell C5
Range("C5").Select
If IsEmpty(Range("C5")) Then
Else
    If IsEmpty(Range("D5")) Then
        Range("D5").Select
    Else
        Selection.End(xlToRight).Select
        Selection.Offset(0, 1).Select
    End If
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

 

[RMXByker]

That worked great. One last question. I have 2 sub routines. I want the Copy Paste rountine to run followed by a Sort routine. How do I do this by only pressing a button once?

Here is the code I have currently that isn't working....

Sub COPYPASTE()
Worksheets("WORKSHEET").Range("B2:B31").COPY
Worksheets("HRS BY WEEK").Select
'assuming you mean the first empy cell in row 5, starting from cell C5
Range("C5").Select
If IsEmpty(Range("C5")) Then
Else
    If IsEmpty(Range("D5")) Then
        Range("D5").Select
    Else
        Selection.End(xlToRight).Select
        Selection.Offset(0, 1).Select
    End If
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Sub Sort1stPage()
Sheets("SUMMARY").Unprotect Password:="winston"
Range("C4:D36").Select
Selection.SORT Key1:=Range("C4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Sheets("SUMMARY").PROTECT Password:="winston"
End Sub

I want to take the data that is on page "SUMMARY" and sort it in ascending order. My code works great individually but now I want them to run back to back by one button.

Thanks again for your help,
Jon

 

[JackDanIce]

Assuming your sorting code works, then you can combine your code and mine as:

Sub COPYPASTE()
Worksheets("WORKSHEET").Range("B2:B31").COPY
Worksheets("HRS BY WEEK").Select
'assuming you mean the first empy cell in row 5, starting from cell C5
Range("C5").Select
If IsEmpty(Range("C5")) Then
Else
    If IsEmpty(Range("D5")) Then
        Range("D5").Select
    Else
        Selection.End(xlToRight).Select
        Selection.Offset(0, 1).Select
    End If
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Sheets("SUMMARY").Unprotect Password:="winston"
Range("C4:D36").Select
Selection.SORT Key1:=Range("C4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Sheets("SUMMARY").PROTECT Password:="winston"
End Sub

Or if you want to keep the two sections seperate, in the code for the button use:

Call COPYPASTE
Call Sort1stPage

Between the SUB and END SUB lines

 

[SamTYler]

Sub COPYPASTE()
Dim PastePoint As Range
Worksheets("WORKSHEET").Range("B2:B31").COPY
Set PastePoint = Worksheets("HRS BY WEEK").Range("C5")

If IsEmpty(Range(PastePoint)) Then
Else
   Set PastePoint = PastePoint.End(xlToRight).Offset(0, 1)
End If
PastePoint.PasteSpecial Paste:=xlPasteValues, _
                             Operation:=xlNone, _
                           SkipBlanks:=False, _
                            Transpose:=False

DoEvents

Sheets("SUMMARY").Unprotect Password:="winston"
Range("C4:D36").SORT Key1:=Range("C4"), _
                                Order1:=xlAscending, _
                                Header:=xlGuess, _
                       OrderCustom:=1, _
                           MatchCase:=False, _
                           Orientation:=xlTopToBottom, _
                         DataOption1:=xlSortNormal
Sheets("SUMMARY").PROTECT Password:="winston"
End Sub

 

[RMXByker]

I will work on it for awhile. I have some other formatting issues going on right now. It seems like I pretty much got it now though.

Thank you all for your help!

 

[JackDanIce]

Hi SamTyler,

In your code:

If IsEmpty(Range(PastePoint)) Then
Else
   Set PastePoint = PastePoint.End(xlToRight).Offset(0, 1)

If C5 is empty, it selects C5 but then .end(xlToRight) will go to the furthest right column if D5 is empty won't it? And then fail as it tries to move across one column? I may be missing something as I can't see how you account for both C5 and D5 being empty cells when using xlToRight, do you mind explaining please as I'm still learning!

 

[SamTYler]

Actually, I have never used the construct

If Something Then
Else
[/code

I always use
[code]
If IsEmpty(Range(PastePoint)) Then
Set Range(PastePoint = Range(PastePoint)
Else
   Set PastePoint = PastePoint.End(xlToRight).Offset(0, 1)
EndIf

But yo're right

  Set PastePoint = PastePoint.End(xlToRight).Offset(0, 1)[/code
 won't work reliably.

[code]
'No If statement
  Set PastePoint = Range("C3").End(xlToRight).Offset(0, 1)

Should work even without checking if C5 is empty. Or something similar.

Might have to use

Cells(3, Columns.Count).End(xlToLeft) etc