Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with macro!
Hej!
Each months I get one excel file named “update” with 2 columns: in column A is costumers number and name, while in column B is amount (kg) costumer pursued that months. I have 15 files named “salesview15”,” salesview20”, “salesview25” etc. where in column A is costumer nr., in column B is costumers name and in columns C-Z is amount (kg) which customer is pursued last 20 months. In file “salesview 15” customer nr. starts with 15, in file “salesview 20” customer nr starts with 20 etc. I want macro which can transfer amounts (kg) which customer is pursued from file “update” to files salesview. I have this macro which only can transfer to one file(workbook). Private Sub CommandButton1_Click() 'Public Sub Exp663895() Const sSalesFile As String = "d:\salesview.xls" 'Skal ændres Const sSalesSheetName As String = "Sheet1" 'Skal ændres ' sCellToWriteIn - Skal ændres hver måned, så der skrives i den ' rigtige kolonne det er nødvendigt fordi kolonnen ikke kan findes ' automatisk, når ikke der er tal i alle celler. Const sCellToWriteIn As String = "Z1" Dim wkbNew As Excel.Workbook Dim wkbSales As Excel.Workbook Dim wksImport As Excel.Worksheet Dim wksView As Excel.Worksheet Dim lRowFrom As Long Dim lRowTo As Long Dim bFound As Boolean 'On Error GoTo CleanUp Set wkbNew = ActiveWorkbook Set wksImport = wkbNew.ActiveSheet Set wkbSales = Application.Workbooks.Open(Filename:=sSalesFile) Set wksView = wkbSales.Worksheets(sSalesSheetName) ' 2-tallet her bestemmer hvilken række det første kundenr findes i (Update-filen) For lRowFrom = 2 To wksImport.UsedRange.Rows.Count bFound = False ' 3-tallet her bestemmer hvilken række det første kundenr findes i (Salgsview-filen) For lRowTo = 3 To wksView.UsedRange.Rows.Count If Val(wksImport.Cells(lRowFrom, 1).Value) = _ wksView.Cells(lRowTo, 1).Value Then wksView.Cells(lRowTo, wksView.Range(sCellToWriteIn).Column).Value = _ wksImport.Cells(lRowFrom, 2).Value bFound = True Exit For End If Next lRowTo If Not bFound Then 'Cellen bliver rød, hvis ikke den er overført til opsummeringsarket wksImport.Cells(lRowFrom, 1).Interior.ColorIndex = 3 End If Next lRowFrom CleanUp: Set wksImport = Nothing Set wksView = Nothing Set wkbNew = Nothing Set wkbSales = Nothing 'End Sub End Sub |
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 |