根据一列中的信息自动将一行从一张纸复制到另一张纸，并按日期（以月为单位）排序

Question

Right, I'm having an issue that I'm hoping one (or more) of you will be able to help me with.

For a week now, I've been trying to work out how I can automatically copy and update rows from one sheet in my Workbook to separate sheets based on the month of a date in the second column.

I've tried everything I can think of, VLOOKUP doesn't seem to do it and I know little about VBA to be able to work out how it may work.

I did find a solution that looked promising Using VBA, that split all the varying rows based on the different values in one of the columns (I created an extra column and formatted it to text and then put JAN 15, FEB 15 etc.) then created new tabs and inserted the data into those. Unfortunately, for some reason this ended up creating excess tabs and wouldn't update the breakdown sheets when I changed the Master sheet.

The code I found was:

Sub parse_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 1        
Set ws = Sheets("Sheet1")        
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:C1"            
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub

Now, what I'd really like is for excel to search through the dates in column C, and depending on month, move them into the relevant sheet, but in a way that if I update the main sheet, the monthly sheets are updated automatically. I don't know if this is possible, but surely it must be (it probably isn't even difficult). If necessary, I'd be happy to put in a further column with "Jan 15", "Feb 15" etc. or have a button that I can press to update everything.

Any help would be greatly appreciated!

Answer 1

Your code looks like a bit of an overkill, here I wrote a piece of code that would do the job if extended a bit, you need to add some cases, secure from errors in case the sheet is already there, and adjust the paste location but its a start(will also have more learning value for ya) :)

Sub haha()

Dim ws As Worksheet
Dim i As Integer
Dim lastrow

Set ws = ActiveSheet
lastrow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

For i = 1 To lastrow

Select Case Format(ws.Range("c" & i).Value, "mm")

Case "01"

Sheets.Add.Name = "Jan"
ws.Range("C" & i).EntireRow.Copy Sheets("Jan").Range("A1")


End Select
Next i
End Sub

cheers

Answer 2

If it were going to be a code that you wanted to put to a button, I would do something like:

dim b2 as Workbook
Set b2=ThisWorkbook

xrowx=1
datecol='whatever column that you have the "Feb15" "Jan 15" data in

Do While xrowx<=Worksheetfunction.CountA(b2.Sheets(1).Range("A:A"))


month=Left(b2.Sheet(1).cells(xrowx,datecol))

if month="Jan" then
    emptyrow=Worksheetfunction.CountA(b2.sheets(2).Range("A:A")+1

    col=1

    Do While col<=datecol
    b2.sheets(2).cells(emptyrow,col)=b2.Sheets(1).Cells(emptyrow,col)
    col=col+1

    Loop

elseif month="Feb" then
    emptyrow=Worksheetfunction.CountA(b2.sheets(3).Range("A:A")+1

    col=1

    Do While col<=datecol
    b2.sheets(3).cells(emptyrow,col)=b2.Sheets(1).Cells(emptyrow,col)
    col=col+1

    Loop

elseif ...

...'continue on in this manner for all months

xrowx=xrowx+1

Loop

It's not super pretty or the most optimized way to get it done, but it is easy to understand and should give you a decent framework to build something that suites your needs well (Note: this code could also be used to auto-update as part of a built in sheet macro, but due to the fact that with very large data sets it will be a bit sluggish, that' not recommended)