VBA Copying Range Based on Cell Value

Syncert

New Member
Joined
Apr 19, 2019
Messages
4
Hi Again! I'm very new to VBA. I'm creating a macro to copy a range based upon a singular cell's value on an active sheet.

Sub copyreport()


If ActiveSheet.Range("W25").Value <= "5" Then
Range("A1:X37").Select
Range("X37").Activate
Application.CutCopyMode = False
Selection.Copy


ElseIf ActiveSheet.Range("W25").Value <= "10" Then
Range("A1:X45").Select
Range("X45").Activate
Application.CutCopyMode = False
Selection.Copy


ElseIf ActiveSheet.Range("W25").Value <= "15" Then
Range("A1:X53").Select
Range("X53").Activate
Application.CutCopyMode = False
Selection.Copy


ElseIf ActiveSheet.Range("W25").Value <= "20" Then
Range("A1:X61").Select
Range("X61").Activate
Application.CutCopyMode = False
Selection.Copy

End If




End Sub


What am I doing wrong in this setup? It doesn't copy the range if the Cell = 6 or 19. Cell W25 is only supposed to equal 1-20.

Thanks,
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Re: VBA Code Help - Copying Range Based on Cell Value

You told VBA to copy something, but not where to paste (see NOTE below)
- Using your code you could have achieved the correct results with this
Code:
If ActiveSheet.Range("W25").Value <= [COLOR=#ff0000]5[/COLOR] Then    [I][COLOR=#006400] 'numbers are NOT placed  inside [/COLOR][/I][COLOR=#ff0000]"  "[/COLOR]
    ActiveSheet.Range("A1:X37").Copy Destination:=ActiveSheet.Range("X37")

etc
End If

I think this is what you are trying to achieve

Note in particular
- numbers are NOT placed inside" " (which is notation used for strings)
- sheets and ranges usually do NOT require selecting
- use of variables to avoid repitition
- variable type for v (a number) could be Single, Double, Integer or Long - Double allows for decimal values - so a safe bet here!
- use of With ... End With construction
- all ranges are qualified with a sheet reference
- here qualified using With ActiveSheet .. and .Range - which is the same as ActiveSheet.Range

Code:
Sub copyreport()
    Dim rng As Range, cel As Range, v As Double
  
    With ActiveSheet
        v = .Range("W25")
        If v <= 5 Then
            Set rng = .Range("A1:X37")
            Set cel = .Range("X37")
        ElseIf v <= 10 Then
            Set rng = .Range("A1:X45")
            Set cel = .Range("X45")
        ElseIf v <= 15 Then
            Set rng = .Range("A1:X53")
            Set cel = .Range("X53")
        ElseIf v <= 20 Then
            Set rng = .Range("A1:X61")
            Set cel = .Range("X61")
        End If
[I][COLOR=#006400]'if one of the values met the criteria then copy the correct range[/COLOR][/I]
        If Not rng Is Nothing Then rng.Copy Destination:=cel
        
    End With
End Sub

Select Case instead of If and ElseIf
- in this instance I would probably have used Select Case which is less cumbersome (but does exactly the same job)
Code:
Sub copyreport2()
    Dim rng As Range, cel As Range
    With ActiveSheet
        Select Case .Range("W25")
            Case Is <= 5
                Set rng = .Range("A1:X37")
                Set cel = .Range("X37")
            Case Is <= 10
                Set rng = .Range("A1:X45")
                Set cel = .Range("X45")
            Case Is <= 15
                Set rng = .Range("A1:X53")
                Set cel = .Range("X53")
            Case Is <= 20
                Set rng = .Range("A1:X61")
                Set cel = .Range("X61")
        End Select
[I][COLOR=#006400]'if one of the values met the criteria then copy the correct range[/COLOR][/I]
        If Not rng Is Nothing Then rng.Copy Destination:=cel
    End With
End Sub
 
Last edited:
Upvote 0
Re: VBA Code Help - Copying Range Based on Cell Value

You could also test this to see if it does what you want...

Code:
Sub copyreport4()
    Dim r As Long
    With ActiveSheet
        Select Case .Range("W25")
            Case Is <= 5:   r = 37
            Case Is <= 10:  r = 45
            Case Is <= 15:  r = 53
            Case Is <= 20:  r = 61
        End Select
[I][COLOR=#006400]'if one of the values met the criteria then copy the correct range[/COLOR][/I]
        If  r <> 0 Then .Range("A1").Resize(r).Copy Destination:=.Range("X1").Offset(r - 1)
    End With
End Sub

For info ...
Code:
    Range("A1:A5").Copy Destination:= Range("X5")
can also be writtten without specifying Destination:=
like this:
Code:
    Range("A1:A5").Copy Range("X5")
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top