Option Explicit
Sub subGetData()
' Do The Biz.

Dim llTopRow As Long
Dim llEndRow As Long
Dim slTopCell As String
Dim slEndCell As String
Dim slCol As String
Dim ilCol As Integer
Dim slRow As String
Dim slR As String
Dim slCols1235 As String
Dim slCols235 As String
Dim slTotalCol1 As String
Dim slCols23 As String
Dim ilTotalRow As Integer
Dim blTotalRow As Boolean
Dim blEmptyRow As Boolean
Dim blDelete As Boolean
Dim olWorkBook As Workbook
Dim slWbookname As String
Dim slActiveSheet As String
Dim sl3Chrs As String
Dim olWorkSheet As Worksheet
Dim slWorkSheetName As String
Dim slActiveWBookName As String
Dim ilMonthRow As Integer
Dim ilRow As Integer
Dim slCols12 As String
Dim slcol3 As String
Dim dlamount As Double
Dim dlqty As Double
Dim dlrate As Double
Dim slQty As String
Dim slMonth As String
Dim olR1 As Range
Dim olR2 As Range

' Where am I?
slActiveSheet = UCase(ActiveSheet.Name)

' Pick up Month.
slMonth = ""
For Each olWorkBook In Workbooks
slWbookname = UCase(olWorkBook.Name)
If InStr(slWbookname, "JAN") > 0 Then
slMonth = "JAN"
Exit For
ElseIf InStr(slWbookname, "JAN") > 0 Then
slMonth = "JAN"
Exit For
ElseIf InStr(slWbookname, "FEB") > 0 Then
slMonth = "FEB"
Exit For
ElseIf InStr(slWbookname, "MAR") > 0 Then
slMonth = "MAA"
Exit For
ElseIf InStr(slWbookname, "APR") > 0 Then
slMonth = "APR"
Exit For
ElseIf InStr(slWbookname, "MAY") > 0 Then
slMonth = "MEI"
Exit For
ElseIf InStr(slWbookname, "JUN") > 0 Then
slMonth = "JUN"
Exit For
ElseIf InStr(slWbookname, "JUL") > 0 Then
slMonth = "JUL"
Exit For
ElseIf InStr(slWbookname, "AUG") > 0 Then
slMonth = "AUG"
Exit For
ElseIf InStr(slWbookname, "SEP") > 0 Then
slMonth = "SEP"
Exit For
ElseIf InStr(slWbookname, "OCT") > 0 Then
slMonth = "OKT"
Exit For
ElseIf InStr(slWbookname, "NOV") > 0 Then
slMonth = "NOV"
Exit For
ElseIf InStr(slWbookname, "DEC") > 0 Then
slMonth = "DEC"
Exit For
End If
Next olWorkBook

' Now we have a month and a workbook name.
subCopyDataToTemp slWbookname
subFormatAtoF
subDel1
subGoToEndTotalRow
ilTotalRow = ActiveCell.Row

' From here start to delete blank rows.
For llEndRow = ilTotalRow To 1 Step -1

' Make sure of the active cell.
Cells(llEndRow, 1).Select

slCols1235 = _
Trim(ActiveCell.Text) _
& Trim(ActiveCell.Offset(0, 1).Text) _
& Trim(ActiveCell.Offset(0, 2).Text) _
& Trim(ActiveCell.Offset(0, 4).Text) _

slCols235 = _
Trim(ActiveCell.Offset(0, 1).Text) _
& Trim(ActiveCell.Offset(0, 2).Text) _
& Trim(ActiveCell.Offset(0, 4).Text)

slCols23 = _
Trim(ActiveCell.Offset(0, 1).Text) _
& Trim(ActiveCell.Offset(0, 2).Text)

slCols12 = _
Trim(ActiveCell.Text) _
& Trim(ActiveCell.Offset(0, 1).Text)

slTotalCol1 = _
Trim(ActiveCell.Text)

slcol3 = _
Trim(ActiveCell.Offset(0, 2).Text)

slCols1235 = UCase(slCols1235)
slCols235 = UCase(slCols235)
slCols23 = UCase(slCols23)
slTotalCol1 = UCase(slTotalCol1)
slcol3 = UCase(slcol3)
slCols12 = UCase(slCols12)

blDelete = False
Do

' Cols 1,2,3,4 blank.
If slCols1235 = "" Then
blDelete = True
Exit Do
End If

' Cols 2,3,4 blank.
If slCols235 = "" Then
blDelete = True
Exit Do
End If

' Cols 2,3 blank and Total in Col1,
If slCols23 = "" Then
If InStr(slTotalCol1, "TOTAL") > 0 Then
blDelete = True
Exit Do
End If
End If

' Cols 2,3 blank.
If slCols23 = "" Then

' Move stuff around.
ActiveCell.Offset(0, 4).Copy
ActiveCell.Offset(0, 2).PasteSpecial
ActiveCell.Offset(0, -2).Select
ActiveCell.Offset(0, 1).FormulaR1C1 = "1"
Exit Do

End If

If slcol3 = "" Then

dlamount = ActiveCell.Offset(0, 4).Value
dlqty = ActiveCell.Offset(0, 1).Value
dlrate = dlamount / dlqty
ActiveCell.Offset(0, 2).Value = dlrate
Exit Do

End If

Exit Do
Loop

If blDelete Then
Rows(llEndRow).Select
Selection.Delete Shift:=xlDown

Else

' Fill in the "Total" column.
ActiveCell.Offset(0, 3).FormulaR1C1 = "=RC[-2]*RC[-1]"

End If

If ActiveCell.Row = 1 Then
Exit For
End If

Next llEndRow

subInsertComparison
subFormatAtoF
Worksheets(slActiveSheet).Activate
subInsertNewMonth

' Top Left Cell of Paste.
' Should be in col A.
Set olR1 = ActiveCell
ilRow = olR1.Row

' Where to move it to?
' Where is the month col?
Range("A1").Select
Do
If UCase(ActiveCell.Text) = "MAAND" Then
Exit Do
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
Do
If InStr(UCase(ActiveCell.Text), slMonth) > 0 Then
Exit Do
Else
ActiveCell.Offset(0, 1).Select
End If
Loop

ActiveCell.Offset(0, ActiveCell.Column - 1).Select
ilCol = ActiveCell.Column

Cells(ilRow, ilCol).Select

olR1.Offset(0, 2).Select
Range(ActiveCell, ActiveCell.Offset(0, 2)).Select
Range(Selection, Selection.End(xlDown)).Select

Selection.Cut
olR2.Select
ActiveSheet.Paste ' <<<<<<<<<<<<Problem here!
'Selection.PasteSpecial _
Paste:=xlValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False


'
**********************************************************************
******
End Sub
Sub subDel1()
' Initial delete of unwanted rows.

' Get Month.

Rows("1:4").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Columns("A:C").Select
Selection.Delete Shift:=xlToLeft
Columns("D:D").Select
Selection.Insert Shift:=xlToRight

'
**********************************************************************
******
End Sub
Sub subGoToEndTotalRow(Optional ipStartRow As Variant)
' Go way down and move up till we hit "TOTAL".

Dim ilTotalRow As Integer
Dim llEndRow As Long
Dim slCellTest As String
Dim ilStartRow As Integer

If IsMissing(ipStartRow) Then
ilStartRow = 200
Else
ilStartRow = ipStartRow
End If

Range("a" & ilStartRow).Select
ilTotalRow = 0
For llEndRow = ilStartRow To 1 Step -1
slCellTest = ActiveCell.Text _
& ActiveCell.Offset(0, 1).Text _
& ActiveCell.Offset(0, 2).Text _
& ActiveCell.Offset(0, 3).Text _
& ActiveCell.Offset(0, 4).Text
If slCellTest <> "" Then
If InStr(slCellTest, "TOTAL") > 0 Then
ilTotalRow = llEndRow
Exit For
End If
End If
If ActiveCell.Row > 1 Then
ActiveCell.Offset(-1, 0).Select
End If
Next llEndRow
'
**********************************************************************
******
End Sub
Sub subInsertComparison()
' Set RED for not equal.

Dim rlRange As Range

Cells.Select
Selection.FormatConditions.Delete

Range("e1").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add _
Type:=xlCellValue, _
Operator:=xlNotEqual, _
Formula1:="=D1"
Selection.FormatConditions(1).Font.ColorIndex = 3
Selection.Copy

Range("e2").Select
Range(Selection, Selection.End(xlDown)).Select

Selection.PasteSpecial _
Paste:=xlFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

'
**********************************************************************
******
End Sub
Sub subInsertNewMonth()
' Insert a new month from Temp.

Dim slSheetName As String
Dim slActiveSheet As String
Dim sl3Chrs As String
Dim olWorkSheet As Worksheet
Dim slWorkSheetName As String

' What's this sheet name?
slActiveSheet = UCase(ActiveSheet.Name)
sl3Chrs = UCase(Mid(slActiveSheet, 1, 3))

For Each olWorkSheet In Worksheets
slWorkSheetName = UCase(olWorkSheet.Name)
If Mid(slWorkSheetName, 1, 4) = "TEMP" Then
If InStr(slWorkSheetName, sl3Chrs) > 0 Then
olWorkSheet.Activate
Range("a1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 3).Select
Range(ActiveCell, "a1").Select
Selection.Copy
Worksheets(slActiveSheet).Activate
subGoToInsertRow
Selection.PasteSpecial _
Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Exit For
End If
End If
Next olWorkSheet
'
**********************************************************************
******
End Sub
Sub subGoToInsertRow()
' Go way down and back up to paste.

Range("a1").Select
Do
Selection.End(xlDown).Select
If ActiveCell.Row > 65000 Then
Exit Do
End If
Loop
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
'
**********************************************************************
******
End Sub
Sub subCopyDataToTemp(spWBook As String)
' Go to the correct sheet.

Dim slSheetName As String
Dim slActiveSheet As String
Dim sl3Chrs As String
Dim olWorkSheet As Worksheet
Dim slWorkSheetName As String
Dim slActiveWBookName As String

slActiveSheet = UCase(ActiveSheet.Name)
sl3Chrs = UCase(Mid(slActiveSheet, 1, 3))
slActiveWBookName = ActiveWorkbook.Name

Workbooks(spWBook).Activate
For Each olWorkSheet In Worksheets
slWorkSheetName = UCase(olWorkSheet.Name)
If InStr(slWorkSheetName, sl3Chrs) > 0 Then
olWorkSheet.Activate
Exit For
End If
Next olWorkSheet

Cells.Select
Selection.Copy
Workbooks(slActiveWBookName).Activate
For Each olWorkSheet In Worksheets
slWorkSheetName = UCase(olWorkSheet.Name)
If Mid(slWorkSheetName, 1, 4) = "TEMP" Then
If InStr(slWorkSheetName, sl3Chrs) > 0 Then
olWorkSheet.Activate
Cells.Select
Selection.PasteSpecial _
Paste:=xlValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Exit For
End If
End If
Next olWorkSheet

'
**********************************************************************
******
End Sub
Sub subFormatAtoF()

Columns("A:F").Select
Columns("A:F").EntireColumn.AutoFit
Columns("B:F").Select
Selection.NumberFormat = "0.00"
Range("A1").Select
Application.CutCopyMode = False


'
**********************************************************************
******
End Sub