A
Alen32
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
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