copy data from sheet to another based on month using inputbox with arrays

alhagag · May 9th 2020

hello

i need help from experts to copy data from sheet1 to sheets(may,jun,July...etc) it depends on what write into inputbox if i write may then copy data only dates of may months to sheet called may and so on the rest of months and sheets if is possible do that by array because it's quick i have no experience that that's why i request that i do a simple code but i think it's not practical i search so much in the internet to get code like my demand and adjusted what i need but i failed

Code

Sub MoveData()

For Each cell In Range("A1:A111") ' Where to look for the date
If cell.Value = "1/05/2020" Then ' The date
    Range("A4:D100").Select ' What is the range to copy
    Selection.Copy ' Copy it
    Sheets("SHEET1").Select ' Select the Sheet it applies to
    Range("A1").Select ' Where to paste the data
    ActiveSheet.Paste
    Sheets("MAY").Select ' Go back to the templete sheet
    Range("A1").Select
    Application.CutCopyMode = False ' Remove the copy mode
End If
Next ' Move forward to the next
For Each cell In Range("a1:a100")
If cell.Value = "1/06/2020" Then
    Range("A4:D100").Select
    Selection.Copy
    Sheets("JUNE").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("SHEET1").Select
    Range("A1").Select
    Application.CutCopyMode = False
End If
Next
End Sub

Display More

**royUK** · May 9th 2020

All that selecting is not necessary and will slow down your code.

Looping through a range cell by cell will also result in slow code.

It's also, not a good idea to split data like that.

Attach an example workbook

alhagag · May 9th 2020

this is my file

**royUK** · May 9th 2020

Try this

Code

Sub SplitMonths()
Dim rData As Range
Dim iX As Integer
With Sheets("SHEET1")
''/// check if AutoFilter is on, if not swith on
If Not .AutoFilterMode Then .Range("A1").AutoFilter
''/// add range to filter
Set rData = .Cells(1).CurrentRegion
On Error Resume Next
For iX = 1 To 12
rData.AutoFilter Field:=1, Operator:= _
xlFilterValues, Criteria2:=Array(1, iX & "/1/2020")
'/// copy filtered data to destination sheet
Sheets(MonthName(iX)).Clear
.AutoFilter.Range.Copy Sheets(MonthName(iX)).Range("A1")
Next iX
On Error GoTo 0
End With
End Sub

Display More

**royUK** · May 9th 2020

Why have you posted this question twice?

alhagag · May 9th 2020

i'm sorry about posted this question twice , i make mistake

for your code it just auto filter in sheet1 no data coped in may,june and i would that by use tool inputbox and write the month to copy to sheet called month may or June i attached some image about expected result

**royUK** · May 9th 2020

It does copy to the other sheets.

I didn't bother with the InputBox because it will slow the code and relies on the correct information being inputted. My code copies the data if there are sheets named May and June.

**royUK** · May 9th 2020

This is a final warning about cross posting. Next time I will ban you from posting on the Forum

alhagag · May 9th 2020

hi, Royuk

i no know where is the problem i downloaded your file and clear sheets may, june an run code again no data transfer to may,june

this is mystery

**royUK** · May 9th 2020

The code does move the data, but your May dates are entered with a formula.

Have you tried the xample workbook I uploaded.

Also, I hope you have taken notice of what I said about cross posting.

alhagag · May 9th 2020

i'm talking about your file i really used it when i open file i found the data in may,June and when i cleared them and run code again it doesn't copy any data in may,June it's strange

for your noticing i would recommend my apology about issue this subject twice in two different forums i know this is wrong and waste time the members while if is solved i don't do this deliberately i would say to you i don't repeat this in the future

this is my subject in this forum

https://www.mrexcel.com/board/…nth.1133502/#post-5483071

alhagag · May 9th 2020

actually , it solved my problem in attached link above i would thank you for help despite my problem is solved i'm still interesting your code because it is simple and short , i would for you fix and find out where is problem with me don't run the code it's up to you if you don't mind many resources are useful i hope to don't upset you

**royUK** · May 10th 2020

There is no problem with my code and it is much faster than your proposed solution

alhagag · May 10th 2020

i know Royuk your code is very practical ,honestly your file despite works with you but me it doesn't , do you have any idea ? the problem code works but no data in sheets(may,june)

**royUK** · May 10th 2020

Can you attach the workbook that you are using.

alhagag · May 10th 2020

here is the file

**royUK** · May 10th 2020

I've downloaded the file and it works fine for me.

alhagag · May 10th 2020

it's mystery , doesn't work so far , i remove this from code

Code

On Error Resume Next

and gives me error about this line

Code

Sheets(MonthName(iX)).Cells.Clear

subscript out of range

**royUK** · May 10th 2020

That will cause an error because you don't have a full year's sheets. I put the on error in to allow for that.

I've amended the code to only run on May & June.

Code

Sub SplitMonths()
Dim rData As Range
Dim iX As Integer


With Sheets("SHEET1")
''/// check if AutoFilter is on, if not swith on
If Not .AutoFilterMode Then .Range("A1").AutoFilter
''/// add range to filter
Set rData = .Cells(1).CurrentRegion
'        On Error Resume Next
For iX = 5 To 6
rData.AutoFilter Field:=1, Operator:= _
xlFilterValues, Criteria2:=Array(1, iX & "/1/2020")
'/// copy filtered data to destination sheet
Sheets(MonthName(iX)).Cells.Clear
.AutoFilter.Range.Copy Sheets(MonthName(iX)).Range("A1")
Next iX
.ShowAllData
On Error GoTo 0
End With
End Sub

Display More

alhagag · May 10th 2020

it gives me the same error i put a new code in module2

copy data from sheet to another based on month using inputbox with arrays

Participate now!

Share