Séparer "Année" à plusieurs feuilles de calcul selon une colonne

Question

Cette tâche me rend fou ... s'il vous plaît aider! Au lieu de taper manuellement les données, j'ai utilisé VBA pour trouver la plage de l'année, mettre dans une colonne et supprimer tous les doublons. Mais puisque Excel pourrait donner plus de 20 ans, il serait fastidieux de faire tout le filtrage manuellement. ET, maintenant j'ai besoin d'Excel pour séparer les rangées qui contiennent la gamme d'année spécifique dans l'une des trois colonnes et les mettre dans une nouvelle feuille.

par exemple. Les années que Excel a pu trouver dans les trois colonnes (F: H) sont (2001,2003,2006,2010, 2012,2020 ..... 2033) ... et elles sont collées dans la colonne "S" de la feuille 1 Comment pourrais-je dire à Excel de créer de nouvelles feuilles pour les années (feuilles 2001, feuilles 2003, feuille2006 ....), chercher dans la colonne (F: H) dans la feuille 1 pour voir si TOUTES ces colonnes contiennent cette année, et coller dans la nouvelle feuille. Pour être plus précis, dans la "Feuille 2001" nouvellement créée, la ligne entière où la colonne (F: H) contient "2001" doit être collée. et dans la "Feuille 2033" nouvellement créée, la ligne entière où la colonne (F: H) contient "2033" doit être collée.

Veuillez trouver ci-joint la référence. J'ai les feuilles "2002" et "2003" ici comme résultats mais pour la vraie, je vais avoir besoin de plus de feuilles d'années (autant d'excel qu'excel pour l'étape précédente, comme indiqué dans la colonne L). ..... Je pense que cette tâche devrait être assez habituelle (extraction par date), mais je ne pouvais pas google le résultat .... Pleas aide !! Je suis très clueless sur la façon de faire boucle .. donc s'il vous plaît des conseils et donnez plus de détails! Merci

Answer 1

Vous avez demandé quelque chose de similaire dans splite the entire row with a specific YEAR value to other worksheet. vba excel et j'ai dit que vous pouvez utiliser ADO. Ce n'est pas un code définitif, c'est une démonstration:

Dim cn As Object 
Dim rs As Object 
Dim rs2 As Object 
Dim sFile As String 
Dim sCon As String 
Dim sSQL As String 
Dim s As String 
Dim i As Integer, j As Integer 

''This is not the best way to refer to the workbook 
''you want, but it is very convenient for notes 
''It is probably best to use the name of the workbook. 

sFile = ActiveWorkbook.FullName 

''Note that if HDR=No, F1,F2 etc are used for column names, 
''if HDR=Yes, the names in the first row of the range 
''can be used. 
''This is the Jet 4 connection string, you can get more 
''here : http://www.connectionstrings.com/excel 

sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sFile _ 
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";" 

''Late binding, so no reference is needed 

Set cn = CreateObject("ADODB.Connection") 
Set rs = CreateObject("ADODB.Recordset") 
Set rs2 = CreateObject("ADODB.Recordset") 


cn.Open sCon 

sSQL = "SELECT Year([ Date]) As YrDate " _ 
     & "FROM [Sheet1$] " _ 
     & "UNION " _ 
     & "SELECT Year([ Date i]) As YrDate " _ 
     & "FROM [Sheet1$] " _ 
     & "UNION " _ 
     & "SELECT Year([ Date ii]) As YrDate " _ 
     & "FROM [Sheet1$] " _ 
     & "UNION " _ 
     & "SELECT Year([Date iii]) As YrDate " _ 
     & "FROM [Sheet1$] " 

rs.Open sSQL, cn, 3, 3 

i = 3 ''Start adding worksheets at this number 
Do While Not rs.EOF 

sSQL = "SELECT Dte, Dta, Nmbr, No2, SerialNo FROM " _ 
     & "(SELECT [ Date] As Dte, [Data] As Dta, [ No] As Nmbr, " _ 
     & "[ No 2] As No2, [Serial No] As SerialNo " _ 
     & "FROM [Sheet1$] " _ 
     & "UNION ALL " _ 
     & "SELECT [ Date i] As Dte, [Data] As Dta, [ No] As Nmbr, " _ 
     & "[ No 2] As No2, [Serial No] As SerialNo " _ 
     & "FROM [Sheet1$] " _ 
     & "UNION ALL " _ 
     & "SELECT [ Date ii] As Dte, [Data] As Dta, [ No] As Nmbr, " _ 
     & "[ No 2] As No2, [Serial No] As SerialNo " _ 
     & "FROM [Sheet1$] " _ 
     & "UNION ALL " _ 
     & "SELECT [Date iii] As Dte, [Data] As Dta, [ No] As Nmbr, " _ 
     & "[ No 2] As No2, [Serial No] As SerialNo " _ 
     & "FROM [Sheet1$]) " _ 
     & "WHERE Year(Dte)= " & rs!YrDate 

    rs2.Open sSQL, cn, 3, 3 

    ''Pick a suitable empty worksheet for the results 
    Worksheets.Add 
    With Worksheets("Sheet" & i) 
     .Cells(1, 1) = rs!YrDate 

     For j = 0 To rs2.Fields.Count - 1 
      .Cells(2, j + 1) = rs2.Fields(j).Name 
     Next 

     .Cells(3, 1).CopyFromRecordset rs2 
    End With 

    rs.MoveNext 
    i = i + 1 
    rs2.Close 
Loop 

''Tidy up 
rs.Close 
Set rs = Nothing 
cn.Close 
Set cn = Nothing