Copy Selected range to another sheet with define range within cell

francozzy

New Member
Joined
Apr 3, 2018
Messages
26
Hi,

i'm newbie on vba excel

I would like to copy some range on selected sheet to another sheet, and defined the range with value from another sheet

i'll give the illustration below :

SheetA
[TABLE="class: outer_border, width: 500, align: center"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]100[/TD]
[TD="align: center"]400[/TD]
[TD="align: center"]700[/TD]
[TD="align: center"]1000[/TD]
[TD="align: center"]1300[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]200[/TD]
[TD="align: center"]500[/TD]
[TD="align: center"]800[/TD]
[TD="align: center"]1100[/TD]
[TD="align: center"]1400[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]300[/TD]
[TD="align: center"]600[/TD]
[TD="align: center"]900[/TD]
[TD="align: center"]1200[/TD]
[TD="align: center"]1500[/TD]
[/TR]
</tbody>[/TABLE]

SheetB
[TABLE="class: outer_border, width: 500, align: center"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]A1[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]D2[/TD]
[TD="align: center"][/TD]
[/TR]
</tbody>[/TABLE]


I want to copy selected range from SheetA to new Worksheet SheetC,
with specific value of Range that has been define at SheetB

So what i have to do ?

thank you
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Try this:
Code:
Sub Copy_Dates()
'Modified 4-4-18 6:35 AM EDT
ans = Weekday(Date)
Dim LastColumn As Long
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
Dim SearchString As String
Dim SearchRange As Range
SearchString = ans
Dim Lastrow As Long
Set SearchRange = Range(Cells(1, 1), Cells(1, LastColumn)).Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)
If SearchRange Is Nothing Then MsgBox "That day  " & ans & "  Cannot be found" & vbNewLine & " I will Stop the script": Exit Sub
Lastrow = Cells(Rows.Count, SearchRange.Column).End(xlUp).Row
LastColumn = Sheets(3).Cells(1, Columns.Count).End(xlToLeft).Column + 1
SearchRange.Offset(, -1).Resize(Lastrow, 3).Copy Sheets(3).Cells(1, LastColumn)
End Sub

Could you added some comment to explain the process, so if i need to change little bit, i can start from your explanation in comments

Thank you
 
Upvote 0
I made a mistake:
Try this:
Code:
Sub Copy_Dates()
'Modified 4-4-18 7:05 AM EDT
ans = Day(Date)
Dim LastColumn As Long
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
Dim SearchString As String
Dim SearchRange As Range
SearchString = ans
Dim Lastrow As Long
Set SearchRange = Range(Cells(1, 1), Cells(1, LastColumn)).Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)
If SearchRange Is Nothing Then MsgBox "That day  " & ans & "  Cannot be found" & vbNewLine & " I will Stop the script": Exit Sub
Lastrow = Cells(Rows.Count, SearchRange.Column).End(xlUp).Row
LastColumn = Sheets(3).Cells(1, Columns.Count).End(xlToLeft).Column + 1
SearchRange.Offset(, -1).Resize(Lastrow, 3).Copy Sheets(3).Cells(1, LastColumn)
End Sub
 
Upvote 0
first, my Sheet1 like below

image.png


and after running your code
i got this message

image.png


So what i have to do ?
 
Upvote 0
You need to be running the script from the sheet with all this data

The script looks in row(1) for a 4 that is todays day
Your sheet looks like a 4 is in row(1)

It must be 4 and nothing else.

Do you have a button on this sheet where you are running the script from
Or are you running the script from a button on sheet 3
 
Last edited:
Upvote 0
You need to use my script in post 25
And run the script from sheet(1)

If you have to run the script from some other sheet you will have to let me know.
I will be offline for several hours.
But you need to make sure the script is doing what you want before I modify it so you can run it from another sheet if needed.
 
Upvote 0
You need to use my script in post 25
And run the script from sheet(1)

If you have to run the script from some other sheet you will have to let me know.
I will be offline for several hours.
But you need to make sure the script is doing what you want before I modify it so you can run it from another sheet if needed.

sorry for my late response too.

i'll already try to change your code little bit like below

Code:
    ThisWorkbook.Sheets(1).Activate
    
    ans = Day(Date)
    
    Dim LastColumn As Long
    Dim SearchString As String
    Dim SearchRange As Range
    Dim Lastrow As Long
    
    LastColumn = ThisWorkbook.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
    
    MsgBox LastColumn
    
    SearchString = ans
    
    Set SearchRange = ThisWorkbook.Sheets(1).Range(ThisWorkbook.Sheets(1).Cells(1, 1), _
    ThisWorkbook.Sheets(1).Cells(1, LastColumn)).Find(SearchString, _
    LookIn:=xlValues, lookat:=xlWhole)
    
    If SearchRange Is Nothing Then MsgBox "That day  " & ans & "  Cannot be found" & _
    vbNewLine & " I will Stop the script": Exit Sub
    
    Lastrow = ThisWorkbook.Sheets(1).Cells(ThisWorkbook.Sheets(1).Rows.Count, SearchRange.Column).End(xlUp).Row
    LastColumn = Sheets(3).Cells(1, Columns.Count).End(xlToLeft).Column
    SearchRange.Offset(, -1).Resize(Lastrow, 5).Copy Sheets(3).Cells(1, LastColumn)


trying to put 4 next day as the variable
and running like the way i expected

let me try for various variable,
Is that ok, if i back to this thread when i meet any issue with this code ?

Thank you for your help.
 
Upvote 0
Glad to see you like modifying code to your needs. The script ran perfectly for me when run from the master sheet. It would have only taken a line or two of code change if you wanted to run it from another sheet. Have fun.

You never said if it did what you want when you ran it from the Master Sheet.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,329
Members
452,635
Latest member
laura12345

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