Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with macro!
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro recorded... tabs & file names changed, macro hangs | Excel Worksheet Functions | |||
Macro Help Needed - Excel 2007 - Print Macro with Auto Sort | Excel Worksheet Functions | |||
how to count/sum by function/macro to get the number of record to do copy/paste in macro | Excel Programming | |||
macro to delete entire rows when column A is blank ...a quick macro | Excel Programming | |||
Start Macro / Stop Macro / Restart Macro | Excel Programming |