1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
| Sub Nat()
Dim i As Long
Dim j As Long
Dim k As Long
Dim wbName As String
j = 1
Application.Goto Worksheets(1).Range("E7")
For i = 7 To ThisWorkbook.Worksheets(1).Range("A65000").End(xlUp).Row
If Cells(i, 5) = Cells(i + 1, 5) Then
Workbooks.Add
Application.Goto ThisWorkbook.Worksheets(1).Range("E7")
If ThisWorkbook.Worksheets(1).Cells(i, 3) < ThisWorkbook.Worksheets(1).Cells(i + 1, 3) Then
'Take C
Workbooks(2).Worksheets(1).Cells(j, 1) = ThisWorkbook.Worksheets(1).Cells(i, 8)
ElseIf (ThisWorkbook.Worksheets(1).Cells(i, 3) > ThisWorkbook.Worksheets(1).Cells(i + 1, 3)) _
And ThisWorkbook.Worksheets(1).Cells(i, 3) < 37226 Then
'Take C
Workbooks(2).Worksheets(1).Cells(j, 1) = ThisWorkbook.Worksheets(1).Cells(i, 8)
ElseIf (ThisWorkbook.Worksheets(1).Cells(i, 3) > ThisWorkbook.Worksheets(1).Cells(i + 1, 3)) _
And ThisWorkbook.Worksheets(1).Cells(i, 3) > 37226 Then
Workbooks(2).Worksheets(1).Cells(j, 1) = ThisWorkbook.Worksheets(1).Cells(i + 1, 8)
Else: Workbooks(2).Worksheets(1).Cells(j, 1) = ThisWorkbook.Worksheets(1).Cells(i, 8)
End If
For k = 13 To 107
If IsEmpty(Cells(i, k)) And IsEmpty(Cells(i + 1, k)) Then
Else:
Workbooks(2).Worksheets(1).Cells(j, 2) = ThisWorkbook.Worksheets(1).Cells(6, k)
Workbooks(2).Worksheets(1).Cells(j, 4) = ThisWorkbook.Worksheets(1).Cells(i, k).Value + ThisWorkbook.Worksheets(1).Cells(i + 1, k).Value
j = j + 1
End If
Next
j = 1
Workbooks(2).Worksheets(1).Cells(1, 3) = "EUR"
Application.Goto Workbooks(2).Worksheets(1).Range("A1")
Workbooks(2).Worksheets(1).Range("A1").Copy
Workbooks(2).Worksheets(1).Range("A1:A" & Workbooks(2).Worksheets(1).Range("B65000").End(xlUp).Row).Select
ActiveSheet.Paste
Workbooks(2).Worksheets(1).Range("C1").Copy
Workbooks(2).Worksheets(1).Range("C1:C" & Workbooks(2).Worksheets(1).Range("B65000").End(xlUp).Row).Select
ActiveSheet.Paste
Workbooks(2).Worksheets(1).Columns("B:B").NumberFormat = "m/d/yyyy"
Application.Goto Workbooks(2).Worksheets(1).Range("A1")
wbName = ThisWorkbook.Worksheets(1).Cells(i, 5) & " - " & Workbooks(2).Worksheets(1).Range("A1")
ActiveWorkbook.SaveAs Filename:="C:\New Folder\"Nati".csv", _
FileFormat:=xlCSV
Application.DisplayAlerts = False
Workbooks(wbName).Close
Application.DisplayAlerts = True
End If
Next
End Sub |
Partager