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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with macro!
Thanks a lot!!!!!!
|
Reply |
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 |