ppeterk

CasaDoHardware, obrigado pelo retorno e desculpe se não expliquei bem. O código está certo. Acho que era melhor não postá-lo para não causar mais confusão.
 
Em suma meu problema é: Não sei fazer uma macro que separa o arquivo de acordo com um critério (Critério esse que se encontra na coluna B). Só isso!
  De qualquer forma, eu fucei em alguns lugares e encontrei um código que me atende. Agradeço muito pela atenção. Segue o código que me atendeu:
Dim i As Variant Dim aStrings(1 To 121) As Double 'variável contendo 121 variáveis aStrings(1) = 1001 aStrings(2) = 1002 aStrings(3) = 1003 aStrings(4) = 1004 aStrings(5) = 1007 aStrings(6) = 1008 aStrings(7) = 1009 aStrings(8) = 1010 aStrings(9) = 1011 aStrings(10) = 1012 aStrings(11) = 1013 aStrings(12) = 1014 aStrings(13) = 1015 aStrings(14) = 1016 aStrings(15) = 1017 aStrings(16) = 2001 aStrings(17) = 2002 aStrings(18) = 2003 aStrings(19) = 2004 aStrings(20) = 2005 aStrings(21) = 2006 aStrings(22) = 2007 aStrings(23) = 2008 aStrings(24) = 2009 aStrings(25) = 2010 aStrings(26) = 2013 aStrings(27) = 3001 aStrings(28) = 3002 aStrings(29) = 3003 aStrings(30) = 3004 aStrings(31) = 3005 aStrings(32) = 3006 aStrings(33) = 3007 aStrings(34) = 3008 aStrings(35) = 3009 aStrings(36) = 3010 aStrings(37) = 3011 aStrings(38) = 3012 aStrings(39) = 3013 aStrings(40) = 3014 aStrings(41) = 3015 aStrings(42) = 3016 aStrings(43) = 3017 aStrings(44) = 3018 aStrings(45) = 3019 aStrings(46) = 3020 aStrings(47) = 3021 aStrings(48) = 3022 aStrings(49) = 3023 aStrings(50) = 3024 aStrings(51) = 3025 aStrings(52) = 3026 aStrings(53) = 3027 aStrings(54) = 3028 aStrings(55) = 3029 aStrings(56) = 3030 aStrings(57) = 3031 aStrings(58) = 3032 aStrings(59) = 3033 aStrings(60) = 3034 aStrings(61) = 3035 aStrings(62) = 3036 aStrings(63) = 3037 aStrings(64) = 3038 aStrings(65) = 3039 aStrings(66) = 3045 aStrings(67) = 3051 aStrings(68) = 3052 aStrings(69) = 3053 aStrings(70) = 3054 aStrings(71) = 4001 aStrings(72) = 4002 aStrings(73) = 4003 aStrings(74) = 4005 aStrings(75) = 4006 aStrings(76) = 4007 aStrings(77) = 4008 aStrings(78) = 4009 aStrings(79) = 4010 aStrings(80) = 4011 aStrings(81) = 4012 aStrings(82) = 4013 aStrings(83) = 4014 aStrings(84) = 4015 aStrings(85) = 4016 aStrings(86) = 4017 aStrings(87) = 4018 aStrings(88) = 4019 aStrings(89) = 4020 aStrings(90) = 4021 aStrings(91) = 4022 aStrings(92) = 4023 aStrings(93) = 4024 aStrings(94) = 4025 aStrings(95) = 4026 aStrings(96) = 4027 aStrings(97) = 4028 aStrings(98) = 4029 aStrings(99) = 4030 aStrings(100) = 4031 aStrings(101) = 4032 aStrings(102) = 4033 aStrings(103) = 4034 aStrings(104) = 4035 aStrings(105) = 4036 aStrings(106) = 4038 aStrings(107) = 4039 aStrings(108) = 4040 aStrings(109) = 4041 aStrings(110) = 4042 aStrings(111) = 4043 aStrings(112) = 4044 aStrings(113) = 4045 aStrings(114) = 4046 aStrings(115) = 4047 aStrings(116) = 4048 aStrings(117) = 4049 aStrings(118) = 4050 aStrings(119) = 4051 aStrings(120) = 4053 aStrings(121) = 4054 For Each i In aStrings ' for para fazer fazer o loop de variável por variável Workbooks.Open nameFile 'abrir arquivo que ele deve realizar a macro Worksheets(1).Activate 'ativa a sheet1/aba1 Dim lRow As Long Dim lCount As Long Dim lLast As Long With Sheets(1) lLast = .Cells(.Rows.Count, "B").End(xlUp).Row 'percorre até a última linha For lRow = lLast To 2 Step -1 If .Cells(lRow, "B") <> i Then ' se diferente de i começa a apagar da última até a primeira .Rows(lRow).Delete lCount = lCount + 1 End If Next lRow End With Worksheets(2).Activate 'ativa a sheet2/aba2 Dim lRow1 As Long Dim lCount1 As Long Dim lLast1 As Long With Sheets(2) lLast1 = .Cells(.Rows.Count, "B").End(xlUp).Row 'percorre até a última linha For lRow1 = lLast1 To 2 Step -1 If .Cells(lRow1, "B") <> i Then ' se diferente de i começa a apagar da última até a primeira .Rows(lRow1).Delete lCount1 = lCount1 + 1 End If Next lRow1 End With ActiveWorkbook.SaveAs Filename:= _ 'localFile: Local que o usuário escolheu - varTexto: Nome que o usuário deseja localFile & "\" & varTexto & " - " & Range("A2").Text & " - " & Range("C2").Text & ".xlsx" ActiveWorkbook.Close savechanges:=True Application.DisplayAlerts = False 'Subistituir sem dó Next i  

Confere se é o que necessita, @Deltaprimo
Excel.xlsx

@GENECIOFICIAL , gentileza, validar se atende.
 
Acrescentei os meses de janeiro e fevereiro, visto que, talvez, você use em outros momentos.
 
A fórmula permite você arrastar para qualquer direção e sentido.
 
Coloquei outros exemplos, para você avaliar se é coerente com o que deseja!
 
NOVA-PLAN-CONT-COM-FÓRMULAS - Peterk.xlsx

Veja se lhe atende, meu caro!
Pedido Teste_ppeterk.xlsx