Help with macro!

A

Alen32

I got this macro here which work well. I need just one change:
I want to insert values in coulum a,b and d instead of like now a,b and c
(Workbook Destination).
Here is macro:
Private Sub CommandButton2_Click()

Dim wbBonus As Workbook, wbDest As Workbook
Dim a(), i As Long, r As Range, x
Dim b(), l As Long, k As Range, y
Dim c(), v As Long, n As Range, z
Dim d(), u As Long, m As Range, o

'Workbooks.Open Filename:="c:\bonus.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,
smågrisefoder") + _
Application.CountIf(.Range("a:a"), "0621 TM, smågrisefoder")
+ _
Application.CountIf(.Range("c:c"), "DE1100 Himmerland")
ReDim a(1 To x, 1 To 3)
For Each r In .Range("a1", .Range("a65536").End(xlUp))
If r.Value = "0620 TM, smågrisefoder" And _
r.Offset(, 2).Value = "DE1100 Himmerland" Or _
r.Value = "0621 TM, smågrisefoder" 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
Next
'HOLSTEBRO
y = Application.CountIf(.Range("a:a"), "0620 TM, smågrisefoder") +
_
Application.CountIf(.Range("a:a"), "0621 TM, smågrisefoder")
+ _
Application.CountIf(.Range("c:c"), "DE1400 Holstebro")
ReDim b(1 To y, 1 To 3)
For Each k In .Range("a1", .Range("a65536").End(xlUp))
If k.Value = "0620 TM, smågrisefoder" And _
k.Offset(, 2).Value = "DE1400 Holstebro" Or _
k.Value = "0621 TM, smågrisefoder" And k.Offset(,
2).Value = "DE1400 Holstebro" Then
l = l + 1: b(l, 1) = k.Offset(, 1)
b(l, 2) = k.Offset(, 13): b(l, 3) = k.Offset(, 14)
End If
Next
'VESTHIMMERLAND
z = Application.CountIf(.Range("a:a"), "0620 TM, smågrisefoder") +
_
Application.CountIf(.Range("a:a"), "0621 TM, smågrisefoder")
+ _
Application.CountIf(.Range("c:c"), "DE1200 Vesthimmerland")
ReDim c(1 To z, 1 To 3)
For Each n In .Range("a1", .Range("a65536").End(xlUp))
If n.Value = "0620 TM, smågrisefoder" And _
n.Offset(, 2).Value = "DE1200 Vesthimmerland" Or _
n.Value = "0621 TM, smågrisefoder" And n.Offset(,
2).Value = "DE1200 Vesthimmerland" Then
v = v + 1: c(v, 1) = n.Offset(, 1)
c(v, 2) = n.Offset(, 13): c(v, 3) = n.Offset(, 14)
End If
Next
Dim c(), v As Long, n As Range, z
Dim d(), u As Long, m As Range, o

'DJURSLAND
z = Application.CountIf(.Range("a:a"), "0620 TM, smågrisefoder") +
_
Application.CountIf(.Range("a:a"), "0621 TM, smågrisefoder")
+ _
Application.CountIf(.Range("c:c"), "DE1200 Vesthimmerland")
ReDim c(1 To z, 1 To 3)
For Each n In .Range("a1", .Range("a65536").End(xlUp))
If n.Value = "0620 TM, smågrisefoder" And _
n.Offset(, 2).Value = "DE1200 Vesthimmerland" Or _
n.Value = "0621 TM, smågrisefoder" And n.Offset(,
2).Value = "DE1200 Vesthimmerland" Then
v = v + 1: c(v, 1) = n.Offset(, 1)
c(v, 2) = n.Offset(, 13): c(v, 3) = n.Offset(, 14)
End If












End With
With wbDest.Sheets("Ark1")
'.Cells.Clear
.Range("a2").Resize(UBound(a, 1), UBound(a, 2)).Value = a

End With

Erase a
With wbDest.Sheets("Ark2")
'.Cells.Clear
.Range("a2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End With
Erase b
With wbDest.Sheets("Ark3")
'.Cells.Clear
.Range("a2").Resize(UBound(c, 1), UBound(c, 2)).Value = c

End With
Erase c
End Sub
 
S

Seiya

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top