根据一列中的信息自动将一行从一张纸复制到另一张，并按date（按月份）sorting，
对，我有一个问题，我希望你们中的一个（或更多）能够帮助我。
现在一个星期，我一直在努力研究如何在我的工作簿中自动复制和更新行中的行，以便根据第二列中的date月份来分隔工作表。
我试过所有我能想到的，VLOOKUP似乎并没有这样做，我对VBA知道如何工作知之甚less。
我确实find了一个看起来很有前途的解决scheme，使用VBA，根据其中一列中的不同值拆分所有不同的行（我创build了一个额外的列并将其格式化为文本，然后将JAN 15，FEB 15等）创build新的标签并将数据插入到这些标签中。 不幸的是，由于某种原因，这最终创build了多余的选项卡，并且不会在更改主表时更新分解表。
我发现的代码是：
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 现在，我真正喜欢的是，通过C列中的date查找，并根据月份，将它们移动到相关工作表中，但是如果我更新主工作表，每月工作表会自动更新。 我不知道这是否可能，但肯定是可能的（可能并不困难）。 如果有必要的话，我会很乐意再加上“1月15日”，“2月15日”等栏目，或者有一个button可以让我更新一切。
任何帮助将不胜感激！
你的代码看起来有些过火，在这里我写了一段代码，如果扩展了一点就可以完成这个工作，你需要添加一些情况，保证在表单已经存在的情况下不会出错，并且调整粘贴位置但它的一个开始（也将有更多的学习价值雅）:)
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
干杯
如果这将是一个代码，你想要把一个button，我会做这样的事情：
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
这不是超级漂亮或者是最好的方法来完成它，但它很容易理解，应该给你一个体面的框架，以build立一个满足你的需求（注意：这个代码也可以用来自动更新的一部分的内置macros表，但是由于这样一个事实，即对于非常大的数据集，它会有点迟缓，这是不被推荐的）