View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Seiya Seiya is offline
external usenet poster
 
Posts: 12
Default Help with macro!

haven't tested

Private Sub CommandButton2_Click()

Dim wbBonus As Workbook, wbDest As Workbook
Dim a(), i As Long, x
Dim b(), l As Long, y
Dim c(), v As Long, z
Dim r As Range
Workbooks.Open Filename:="c:\Bonus flyt Sap-excel.xls"
Workbooks.Open Filename:="c:\Destination.xls"
Set wbBonus = Workbooks("Bonus flyt Sap-excel.xls")
Set wbDest = Workbooks("Destination.xls")
With wbBonus.Sheets("Ark1")
'HIMMERLAND
x = Application.CountIf(.Range("a:a"), "0620
TM,smagrisefoder") + _
Application.CountIf(.Range("a:a"), "0621 TM,
smagrisefoder") + _
Application.CountIf(.Range("c:c"), "DE1100 Himmerland")
ReDim a(1 To x, 1 To 3)

y = Application.CountIf(.Range("a:a"), "0620 TM,
smagrisefoder") + _
Application.CountIf(.Range("a:a"), "0621 TM,
smagrisefoder") + _
Application.CountIf(.Range("c:c"), "DE1400 Holstebro")
ReDim b(1 To y, 1 To 3)

z = Application.CountIf(.Range("a:a"), "0620 TM,
smagrisefoder") + _
Application.CountIf(.Range("a:a"), "0621 TM,
smagrisefoder") + _
Application.CountIf(.Range("c:c"), "DE1200 Vesthimmerland")
ReDim c(1 To z, 1 To 3)

For Each r In .Range("a1", .Range("a65536").End(xlUp))
If (r.Value = "0620 TM, smagrisefoder" Or _
r.Value = "0621 TM, smagrisefoder") And _
r.Offset(, 2).Value = "DE1100 Himmerland" Then
i = i + 1: a(i, 1) = r.Offset(, 1)
a(i, 2) = r.Offset(, 13): a(i, 3) = r.Offset(, 14)
End If

If (r.Value = "0620 TM, smagrisefoder" Or _
r.Value = "0621 TM, smagrisefoder") And _
r.Offset(, 2).Value = "DE1400 Holstebro" Then
l = l + 1: b(l, 1) = r.Offset(, 1)
b(l, 2) = r.Offset(, 13): b(l, 3) = r.Offset(, 14)
End If

If (r.Value = "0620 TM, smagrisefoder" Or _
r.Value = "0621 TM, smagrisefoder") And _
r.Offset(, 2).Value = "DE1200 Vesthimmerland" Then
v = v + 1: c(v, 1) = r.Offset(, 1)
c(v, 2) = r.Offset(, 13): c(v, 3) = r.Offset(, 14)
End If
Next
End With
With wbDest.Sheets("Ark1")
'.Cells.Clear
For i = LBound(a) To UBound(a)
.Cells(i, "a") = a(i, 1): .Cells(i, "b") = a(i, 2):
..Cells(i, "d") = a(i, 3)
Next
End With
Erase a
With wbDest.Sheets("Ark2")
'.Cells.Clear
For i = LBound(b) To UBound(b)
.Cells(i, "a") = b(i, 1): .Cells(i, "b") = b(i, 2):
..Cells(i, "d") = b(i, 3)
Next
End With
Erase b
With wbDest.Sheets("Ark3")
' .Cells.Clear
For i = LBound(c) To UBound(c)
.Cells(i, "a") = c(i, 1): .Cells(i, "b") = c(i, 2):
..Cells(i, "d") = c(i, 3)
Next
End With
Erase c
End Sub