Szia,

Sajnos nem vagyok még expert, így tudnál segíteni a változóban? Illetve a változó minden sub elejére kell?
Azt látom, ott ahol hibára futok, oda kell majd berakjam az on error goto VÁLTOZÓ. ÉS a változóban lesz majd az iferror, a subok elején meg az Iserror-t false-á teszem.

Köszi!

próbáld meg így:
If Err Then

Esetleg lehetne egy Err.Clear az On Error Resume Next előtt...
Amúgy nem lehet, hogy Selection.Copy mindig hibát dob neked? Asszem talán akkor is hibát dob, ha nem az aktív lapon van a Selection...

[ Szerkesztve ]

JOGI NYILATKOZAT: A bejegyzéseim és hozzászólásaim a személyes véleményemet tükrözik; ezek nem tekinthetők a munkáltatóm hivatalos állásfoglalásának...

Szia,

Délután meg tudom próbálni. selection.copy-nak kell hibát dobnia, mert van amikor üres amit másolok, és akkor ugye az egész sheetet másolná ki (1004-es hiba), de van amikor van benne adat, ugye akkor másolni kéne, és folytatni a sub-ot.

Nem nagyon programoztam még excelben, szóval az én elképzelésem:

Dim IsError as boolean

Private Sub Main -> a fő kódod, gondolom valamilyen eventre fut le az egész cucc

On Error GoTo ErrHandling

valami kód, amit írtál és mindig gebasz van vele...

IF IsError = True Then
Call Sub2
Else
Call Sub3
End IF

valami kód, amit írtál és mindig gebasz van vele...

IF IsError = True Then
Call Sub4
Else
Call Sub5
End IF

exit sub

ErrHangling:
IsError = True
Resume

End Sub

Private Sub Sub2
IsError = False
....

End Sub

Persze lehet ezt még finomítani kell, kb. 5 éve nem nyúltam VBA kódhoz, de kb. így csinálnám. A subokat el is lehet hagyni, csak akkor van értelme külön kódba kiemelni, ha több helyen is használod ugyanazt a kódot.

Ha mondjuk egész kódrészleteket beraknál ide, akkor nagyobb eséllyel tudunk hibát keresni mi is....

"Debugging is like being the detective in a crime movie where you're also the murderer."

Sub All()
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Radler").Activate
Columns("K:K").Select
Selection.Replace What:="/", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("A:A").Select
Range("L1").Select
ActiveCell.Value = "Check if its in masterfile"
Range("L2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MATCH(RC[-1],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
With Sheets("Radler")
LR = Range("K" & Rows.Count).End(xlUp).Row
Range("L1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Range("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$L").AutoFilter Field:=12, Criteria1:= _
"Not in file"
Range("B1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy
If Err.Number <> 0 Then
CevaBelgium
Else
VKtrans
End If
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Radler").Activate
Range("B1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False

Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Radler").Activate
Range("D1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("I" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Radler").Activate
Range("D1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Radler").Activate
Range("G1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, -1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Radler").Activate
Range("K1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "RADLER KFT."
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Year(RC[4])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Month(RC[3])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=isoweeknum(RC[2])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Radler").Activate
Rows("1:1").Activate
Selection.AutoFilter
Columns("L").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate


End Sub

Sub VKtrans()
Selection.Clear
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("VK Transport").Activate
Columns("A:A").Select
Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("V1").Select
ActiveCell.Value = "Check if its in masterfile"
Range("V2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MATCH(RC[-21],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
With Sheets("VK Transport")
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("V1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Range("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$V").AutoFilter Field:=22, Criteria1:= _
"Not in file"
Range("B1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy
If Err.Number <> 0 Then
DSVROADNV
Else
CevaBelgium
End If
Windows("invoices_masterfile.xlsm").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("VK Transport").Activate
Range("B1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False

Windows("raw_invoice_riports.xlsx").Activate
Worksheets("VK Transport").Activate
Range("L1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1, -1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("VK Transport").Activate
Range("L1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False

Windows("raw_invoice_riports.xlsx").Activate
Worksheets("VK Transport").Activate

With Sheets("VK Transport")
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("O2").End(xlDown).Offset(0, 2).Select
Range("Q2", "Q" & LR).Select
End With
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, -1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("VK Transport").Activate
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "VK Transport"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Year(RC[4])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Month(RC[3])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=isoweeknum(RC[2])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("VK Transport").Activate
Rows("1:1").Activate
Selection.AutoFilter
Columns("V:V").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate



End Sub
Sub CevaBelgium()
Selection.Clear
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Ceva Belgium").Activate
Columns("A:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.Value = "Invoice Date"
Range("B1").Select
ActiveCell.Value = "Service Date"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=Date(Left(RC[3],4),mid(RC[3],5,2),right(RC[3],2))"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=iferror(Date(Left(RC[20],4),mid(RC[20],5,2),right(RC[20],2)),RC[-1])"
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("CJ1").Select
ActiveCell.Value = "Check if its in the masterfile"
Range("CJ2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MATCH(RC[-85],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
With Sheets("Ceva Belgium")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("CJ1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Range("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$CJ").AutoFilter Field:=88, Criteria1:= _
"Not in file"
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy
If Err.Number <> 0 Then
Azkar
Else
DSVROADNV
End If
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Ceva Belgium").Activate
Range("B1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Ceva Belgium").Activate

Range("AN1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1, -1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Ceva Belgium").Activate

Range("AN1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Ceva Belgium").Activate
Range("AL1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, -1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Ceva Belgium").Activate
Range("C1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False

Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "CEVA FREIGHT BELGIUM N.V."
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Year(RC[4])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Month(RC[3])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=isoweeknum(RC[2])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Ceva Belgium").Activate
Range("1:1").Select
Selection.AutoFilter
Columns("CJ:CJ").Select
Selection.Delete Shift:=xlToLeft
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate



End Sub


Sub DSVROADNV()
Selection.Clear
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("DSV Road").Activate
Range("S1").Select
ActiveCell.Value = "Check if its in the masterfile"
Range("S2").Select
ActiveCell.FormulaR1C1 = "=Iferror(match(RC[-18],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
With Sheets("DSV Road")
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("S1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Range("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$S").AutoFilter Field:=19, Criteria1:= _
"Not in file"
Range("b1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy
If Err.Number <> 0 Then
DachserBE
Else
Azkar
End If
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("DSV Road").Activate
Range("b1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("DSV Road").Activate
Range("L1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("I" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("DSV Road").Activate
Range("L1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("DSV Road").Activate
With Sheets("DSV Road")
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("M2").End(xlDown).Offset(0, 1).Select
Range("N2", "N" & LR).Select
End With
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, -1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("DSV Road").Activate
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "DSV ROAD N V"
Range("C" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[4])"
Range("D" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=month(RC[3])"
Range("E" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=Isoweeknum(RC[3])"
Range("F" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("DSV Road").Activate
Rows("1:1").Select
Selection.AutoFilter
Columns("S").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate



End Sub

Sub Azkar()
Selection.Clear
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Azkar").Activate
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("P:P").Select
Selection.TextToColumns Destination:=Range("P1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("Z1").Select
ActiveCell.Value = " Check if its in the matserfile"
Range("Z2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MATCH(RC[-25],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
With Sheets("Azkar")
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("Z1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$Z").AutoFilter Field:=26, Criteria1:= _
"Not in file"
Range("O1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy
If Err.Number <> 0 Then
DachserHU
Else
DachserBE
End If
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Azkar").Activate
Range("O1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Range("N1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1, -1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Range("N1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Azkar").Activate
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Azkar").Activate
With Sheets("Azkar")
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("O2").End(xlDown).Offset(0, 1).Select
Range("P2", "P" & LR).Select
End With
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("K" & Rows.Count).End(xlUp).Offset(1, 1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "TRANSPORTES AZKAR, S.A"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Year(RC[4])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Month(RC[3])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=isoweeknum(RC[2])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Azkar").Activate
Range("1:1").Select
Selection.AutoFilter
Columns("Z:Z").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate


End Sub

Sub DachserBE()
Selection.Clear
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser BE").Activate
Range("S1").Select
ActiveCell.Value = "Check if its in masterfile"
Range("s2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MATCH(RC[-2],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
Range("t1").Select
ActiveCell.Value = "Date"
Range("t2").Select
ActiveCell.FormulaR1C1 = "=date(right(RC[-19],4),mid(RC[-19],4,2),left(RC[-19],2))"
With Sheets("Dachser BE")
LR = Range("Q" & Rows.Count).End(xlUp).Row
Range("S1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("T1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Range("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$M").AutoFilter Field:=19, Criteria1:= _
"Not in file"
Range("T1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy
If Err.Number <> 0 Then
WaberersINT
Else
DachserHU
End If
Windows("raw_invoice_riports.xlsx").Activate
Windows("invoices_masterfile.xlsm").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("J" & Rows.Count).End(xlUp).Offset(1, -1).Select
Windows("raw_invoice_riports.xlsx").Activate
Selection.End(xlUp).Select
Range("P1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("J" & Rows.Count).End(xlUp).Offset(1).Select
Windows("raw_invoice_riports.xlsx").Activate
Selection.End(xlUp).Select
Range("P1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Range("F1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Range("M" & Rows.Count).End(xlUp).Offset(0).Select
ActiveCell.Offset(1, -1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Range("Q1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.Offset(0, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("F" & Rows.Count).End(xlUp).Offset(1).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "DACHSER TRANSPORT BELGIE"
Range("C" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[4])"
Range("D" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=month(RC[3])"
Range("E" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=Isoweeknum(RC[3])"
Range("F" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
ActiveSheet.Range("1:1").AutoFilter
Windows("raw_invoice_riports.xlsx").Activate
Rows("1:1").Select
Selection.AutoFilter
Columns("S:T").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate



End Sub
Sub DachserHU()
On Error GoTo 0
Selection.Clear
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser HU").Activate
Range("AJ1").Select
ActiveCell.Value = "Check if its in the masterfile"
Range("AJ2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MATCH(RC[-2],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
With Sheets("Dachser HU")
LR = Range("AH" & Rows.Count).End(xlUp).Row
Range("AJ1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Range("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$AJ").AutoFilter Field:=36, Criteria1:= _
"Not in file"
Range("V1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy

Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser HU").Activate
Range("V1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
If Err.Number <> 0 Then
Vege
Else
WaberersINT
End If
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser HU").Activate
Range("W1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1, -1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser HU").Activate
Range("W1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser HU").Activate
Range("D1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("K" & Rows.Count).End(xlUp).Offset(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser HU").Activate
Range("AH1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "LIEGL & DACHSER SZALLITMANYOZASI ES"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Year(RC[4])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Month(RC[3])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=isoweeknum(RC[2])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser HU").Activate
Rows("1:1").Activate
Selection.AutoFilter
Columns("AJ").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate





End Sub
Sub WaberersINT()
Selection.Clear
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Waberers INT").Activate
Columns("A:A").Select
Range("J1").Select
ActiveCell.Value = "Check if its in masterfile"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MATCH(RC[-8],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
With Sheets("Waberers INT")
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("J1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Range("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$J").AutoFilter Field:=10, Criteria1:= _
"Not in file"
Range("C1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy
If Err.Number <> 0 Then
Vege
Else
Vege
End If
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Waberers INT").Activate
Range("C1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False

Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Waberers INT").Activate
Range("F1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1, -1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Waberers INT").Activate
Range("F1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Waberers INT").Activate
Range("B1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "WABERERS INTERNATIONAL ZRT"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Year(RC[4])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Month(RC[3])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=isoweeknum(RC[2])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Waberers INT").Activate
Rows("1:1").Activate
Selection.AutoFilter
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate

End Sub

Sub Vege()
Selection.Clear
MsgBox "Siker!", vbExclamation
End
End Sub

Így lenne, és a többit már tudjátok

[ Szerkesztve ]

Úbaszki, mi ez a kódkígyó...

Semmi indent, egy csomó tök feleslges sor.

[ Szerkesztve ]

JOGI NYILATKOZAT: A bejegyzéseim és hozzászólásaim a személyes véleményemet tükrözik; ezek nem tekinthetők a munkáltatóm hivatalos állásfoglalásának...

Első körben a felesleges Select és Activate sorokat vedd ki:
- két (vagy több) select egymás után felesleges, csak az utolsó maradjon meg (kiváve, ah a következőben fel van használva a selection, de ezeket inkább egy sorba kell tömöríteni
- aktív sheet-et vagy workbook-ot újra aktiválni felesleges
- a valami.Select + Selected.Value = ... felesleges, helyette valami.Value = ... elég, nem kell kijelölni, ráadásul gyorsabb is
- ha nem Select-tel dolgozol, hanem közvetlen referenciával, akkor nem kell Activate és Select:
Workbooks("Workbook.xls").Worksheet("Sheetnév").Range("CellaReferencia").Value = "valami"
- Copy/PasteSpecial:value helyett sokkal (!) gyorsabb az Array copy: [link]

[ Szerkesztve ]

JOGI NYILATKOZAT: A bejegyzéseim és hozzászólásaim a személyes véleményemet tükrözik; ezek nem tekinthetők a munkáltatóm hivatalos állásfoglalásának...

Na, a feladat a következő: ezt az egészet mentsed el, tedd félre. Nincs az az isten, hogy tapasztalat nélkül ebbe a kóddzsungelben bármit is megtaláljál.

Utána kezd el 0-ról, apránként, minimális kóddal. Ha megy, akkor adjál hozzá még egy részt, és így tovább. Ha nem megy, akkor állj meg és akkor térjünk vissza rá.

"Debugging is like being the detective in a crime movie where you're also the murderer."

Az összes lefut, ha van olyan sor amit másolni kell(ergo nincs 1004-es kód, a másik fájlban van olyan adat amit még ebben nincs), hibátlanul

[ Szerkesztve ]

Ezt megcsináltad? Minden subrutinba rakd be az Err.Clear-t, mert szerintem amikor hiba után bemegy egy hiba sub-ba, akkor megtartja az eredeti hiba értékét és ezért a 2. körben is a hiba sub-ba fog menni, annak ellenére, hogy ott nincsen hiba.

Szóval minden sub elejére rakjad be, hogy Err.Clear....

"Debugging is like being the detective in a crime movie where you're also the murderer."

A bemásolt tengeri kígyóban ilyen részletek vannak:

Range("C1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False

Select utasítások nélkül

usor = Range("C1").End(xlDown).Row
Range("C2:C" & usor).Copy
With Workbooks("invoices_masterfile.xlsm").Sheets("main")
usor = .Range("H" & Rows.Count).End(xlUp).Row + 1
.Range("H" & usor).PasteSpecial Paste:=xlPasteValues
End With

Látod, az usor változót felhasználtam a másoláshoz. Az adatok már ott csücsülnek a vágólapon, a másik füzet egyik lapján új értéket rendelhetek hozzá, jelen esetben a H oszlop első üres sorának a számát.
A Select utasítások ráállnak az adott füzet adott lapjára, ott is bizonyos cellá(k)ra. Ez időveszteség, ráadásul ugrál a kép.

Végül

If Err.Number <> 0 Then
sub3
Else
On Error GoTo 0
sub2
End If

Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

Sziasztok!

Outlook2013 Inbox beérkező levelek küldő, tárgy, dátum, esetleg méret adatait szeretném kigyűjteni egy excel munkalapra. Nyilván a Ctrl+c volna a legegyszerűbb...
Ezt hogy lehet vb-ben megírni? Mondjuk adott, hogy az adott excel is már meg van nyitva illetve nyilván az Outlook is.

Vagy esetleg csak a fent említett adatokat 1db txt file-ba lementeni?

Ha útmutatót adnátok milyen parancsokkal induljak el, nekem az is megfelel.

Segítségeteket előre is köszönöm!

You are being revived

Ezzel a hozzá állással születnek, az örökre úgy hagyott undormányok.

Én kérek elnézést!

kellene egy komolyabb help

a suliban visual studiot használok az otthoni acc-ommal
írtunk egy progit és csak az ottani hálóra mentettem el, de jó lenen a hétvégéán itthon is csinálni
szerintetek a háttérben accomra feltöltötte vajon?
létezik iylen?

[ Szerkesztve ]

Sziasztok!

Érdekes problémával találtam magam szembe:

Feladat:
van egy laza 25ezer soros német-lengyel fordításom, ami egy programból (Siemens TIA Portal) lett exportálva. A "text"manipulálás után szeretném visszatölteni ezt. Persze az új verzió egy libből kikeresve lefordítja amit letud (szakmai szöveg, nem érdemes összekötni semmilyen értelmes fordítóval, max ha gálvölgyi show-t és elégedetlen ügyfelet akarunk)

Megoldási elv(eddig):
létrehoztam egy vbs ole kapcsolatot excellel. (ne kérdezzétek miért, nekem komfortosabb így, mint az excel makrófelületével dolgozni)
A program megnyitja a szótár excelt és az A oszlop elemei lesznek a key-ek, B oszlop azonos sorainak elemei pedig az adatok.
Excel becsuk, új doku kinyit és egy sima compare után beírogatom a lengyel verziót. Ezután elmentem és mindenki boldog....

Probléma:
a txt sorai és az excel cellák tartalma nem azonos szintaxúak -> tele vannak a cellákon belüli "értékek"/adatok sortöréssel.
Erre felkészültem, ezért nem txt a szótár fájlom, hanem excel.
A dictionary key eleme viszont vmiért ezeket nem veszi át.

Másik perverzebb ötletem az lenne, hogy még excelben helyettesíteni kell a vbcrln karaktereket valamilyen egyéb karakterre v láncra amit a mod végén visszahelyettesítenék (és ugye nincs a szövegben persze), de ugye ez plusz munka és nem vagyok túl szorgalmas ilyen fronton.
Szeretek tanulni a hibámból, mert minden bizonyára elvi hibám van.
Kérésre rendelkezésetekre tudom bocsátani az adatokat is, a kód így fest:

xlsx_dict = "U:\6_798\Translate\v01\pl.xlsx"
xlsx_trgt = "U:\6_798\Translate\v01\TIAProjectTexts_mod.xlsx"

Set fso = CreateObject( "Scripting.FileSystemObject" )
Set szotar = CreateObject("Scripting.Dictionary")

Set objExcel = CreateObject("Excel.Application")

if not fso.FileExists(xlsx_dict) then
MsgBox xlsx_dict + " nicht gefunden"
WScript.Quit()
end if

if not fso.FileExists(xlsx_trgt) then
MsgBox xlsx_trgt + " nicht gefunden"
WScript.Quit()
end if

objExcel.WorkBooks.Open xlsx_dict
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

'dict aufladen
for i=1 to 532
tmp1 = cStr(objSheet.Cells(i,1).Value)
tmp2 = cStr(objSheet.Cells(i,2).Value)

if not szotar.exists(tmp1) then
szotar.add tmp1, tmp2
else
'MsgBox "Problem mit key: " + tmp1
end if
next

objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close


objExcel.WorkBooks.Open xlsx_trgt
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

' Übersetzen
for i=2 to 24257
dtext = objSheet.Cells(i,5).Value
if szotar.exists(dtext) then
objSheet.Cells(i,6).Value = szotar(dtext)
else
'
end if
next

objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close


objExcel.Application.Quit

Set objSheet = nothing
set objExcel = nothing
Set szotar = nothing
Set fso = nothing

msgBox "Fertig"

Köszönöm az esetleges ötleteket!
Követem a fórumot és öröm olvasni a profi megoldásaitokat!

RITKÁN, de van hogy a lustaság nem kifizetődő

így már a tesztejim szerint működik:

xlsx_dict = "U:\6_798\Translate\v01\pl.xlsx"
xlsx_trgt = "U:\6_798\Translate\v01\TIAProjectTexts_mod.xlsx"

Set fso = CreateObject( "Scripting.FileSystemObject" )
Set wobu = CreateObject("Scripting.Dictionary")


Set objExcel = CreateObject("Excel.Application")

if not fso.FileExists(xlsx_dict) then
MsgBox xlsx_dict + " nicht gefunden"
WScript.Quit()
end if

if not fso.FileExists(xlsx_trgt) then
MsgBox xlsx_trgt + " nicht gefunden"
WScript.Quit()
end if

objExcel.WorkBooks.Open xlsx_dict
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

'dict aufladen
for i=1 to 532
tmp1 = cStr(objSheet.Cells(i,1).Value)
tmp2 = cStr(objSheet.Cells(i,2).Value)

tmp1 = Replace(tmp1,vbcrln,"</\>")
tmp2 = Replace(tmp2,vbcrln,"</\>")

if not wobu.exists(tmp1) then
wobu.add tmp1, tmp2
else
'MsgBox "Problem mit key: " + tmp1
end if
next

objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close


objExcel.WorkBooks.Open xlsx_trgt
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

'Übersetzen
for i=2 to 24257
dtext = objSheet.Cells(i,5).Value

dtext = Replace(dtext,vbcrln,"</\>")

if wobu.exists(dtext) then
tmp = Replace(wobu(dtext),"</\>",vbcrln)
objSheet.Cells(i,6).Value = tmp
else
'
end if
next

objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close


objExcel.Application.Quit

Set objSheet = nothing
set objExcel = nothing
Set wobu = nothing
Set fso = nothing

msgBox "Fertig"

Sziasztok!

Egy hálózaton van több gép is, ezek közül az egyik egy PI3 amin fut egy Webmin + Apache + MySQL, erre hogy tudok VB.NET-el fel csatlakozni?
MySQL Workbanch-el elérem az adatbázist SSH kapcsolattal
Pi3 IP: 192.168.0.13:22
Pi3 MySQL: 127.0.0.1::3306

Workbanch mind két jelszót kéri a Pi-ét és a adatbázisét is.

"Az agy olyan, mint az ejtőernyő: csak akkor működik, ha nyitott." (Thomas Dewar)

Nyilván az Pi3 IP-je fog neked kelleni, valami általad beállított porttal, amit előtte átengedsz a tűzfalon.
Azt hiszem a mysql-ben használatos user permissionjei is fontosak, már ha nem root-tal akarod használni.

Én kérek elnézést!

Köszi, ezek mind be vannak állítva, másik gépről MySQL Workbanch-el elérem az adatbázist SSH kapcsolattal. Viszont azt nem tudom hogy tudnám ezt VB.NET-ben kivitelezni, eddig csak olyan csatlakozásokat találtam ahol egy IP:port címre kellett kapcsolódni, de nekem meg egyszer a Pi-re, majd onnan a MySQL-re.
Vagy nem tudom

"Az agy olyan, mint az ejtőernyő: csak akkor működik, ha nyitott." (Thomas Dewar)

MySQL-ben kellett beállítani, hogy minden gép elérje most elérem a táblákat, jöhet a programozás

"Az agy olyan, mint az ejtőernyő: csak akkor működik, ha nyitott." (Thomas Dewar)

Sziasztok!

LibreOffice Calc-ot szeretnék vbs-ből manipulálni. Minden fut gond és működik, egyetlen problémám a sheet kiválasztása. Próbáltam több különböző parancsot (index szerint, megnevezés szerint), de sajnos egyik sem működik. Először meg kell nyitnom a fájlt, aminek az activesheet-jét átveszi, emiatt viszont a második megnyitott fájl már írásvédett lesz és az általam generált bagatell módosításokat nem tudom átvenni. (le tudnám menteni más néven, vagyis meg tudnám kerülni ezt a probémát, de nem ez a cél, szeretnék egy elegáns megoldást találni erre)

Mivel a mahinálni kívánt fájl egy nagyon buta, de rendesen levédett fájl, ezért gondoltam arra is, hogy ott lehet a kutya elásva. A megoldásom viszont a teljesen sima új tesztcélra generált fájlt sem tudta az elvárásoknak megfelelően kezelni.
Remélem valaki találkozott már ezzel a problémával.
Köszönöm előre is!

class timecnt
dim st, et, ps, nwt, uswt, swt
end class

dim list(9)

' arrayclass deklaralas
for i=0 to 9
set list(i) = new timecnt
next

' adatok kiolvasasa

'----------------------------------------------------------------------------------------
'http://www.oooforum.de/viewtopic.php?t=44190

Set objServiceManager = WScript.CreateObject("com.sun.star.ServiceManager")
Set StarDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")

cURL = "file:///D:\BR\netzlaufwerk\NFO\vbs\libre_officemuster\test\test.ods"

set oDoc = StarDesktop.loadComponentFromURL( cURL, "_blank", 0, Array() )
set oSheet = oDoc.CurrentController.ActiveSheet

'egyeb nem mukodo megoldasok
'set oSheet = oDoc.getSheets().getByName( "Tabelle1" )
'set oSheets = oDoc.getSheets()
'set oSheet = oSheets.getByIndex(0)
'----------------------------------------------------------------------------------------

call librecalc_read

wknd = false

' szamitasok elvegzese
for i=0 to 9
with list(i)
sh = CutLeft ( .st, ":" )
sm = CutRight( .st, ":" )
eh = CutLeft ( .et, ":" )
em = CutRight( .et, ":" )

wtime = worktime_count(sh, sm, eh, em, .ps)
if not wknd then
if wtime<=8 then
.nwt = wtime
else
.nwt = 8
.uswt = wtime-8
.swt = 0
end if
else
.nwt = 0
.uswt = 0
.swt = wtime
end if
end with
next

' adatok kiirasa
call librecalc_write

erase list

'----------------------------------------------------------------------------------------
set oSheet = nothing
set oDoc = nothing
Set StarDesktop = nothing
Set objServiceManager = nothing
'----------------------------------------------------------------------------------------

MsgBox "process is done"



function worktime_count(starth, startm, endh, endm, pause)
'msgbox starth + " " + startm + "" + endh + " " + endm + " " + pause
worktime_count = cInt(endh) + cInt(endm) / 60 - cInt(starth) - cInt(startm)/60
if pause <> "" then worktime_count = worktime_count - cInt(pause) / 60
end function

function CutLeft(txt, sym)
if txt<>"" then
s_e = inStr( txt, sym )-1
CutLeft = left ( txt, s_e)
end if
end function

function CutRight(txt, sym)
if txt<>"" then
s_a = inStr(txt, sym)
CutRight = right(txt, len(txt) - s_a)
end if
end function

sub librecalc_read()
for i = 0 to 9
list(i).st = oSheet.getCellByPosition( 1, 15 + i ).String 'B16
list(i).et = oSheet.getCellByPosition( 2, 15 + i ).String 'C16
list(i).ps = oSheet.getCellByPosition( 6, 15 + i ).String 'G16
next
end sub

sub librecalc_write()
for i=0 to 9
with list(i)
if .nwt<>0 then
oSheet.getCellByPosition( 3, 15 + i ).Value = .nwt 'D16
end if
if .uswt<>0 then
oSheet.getCellByPosition( 4, 15 + i ).Value = .uswt 'E16
end if
if .swt<>0 then
oSheet.getCellByPosition( 5, 15 + i ).Value = .swt 'F16
end if
end with
next
end sub

Sziasztok!

Egy kicsit elakadtam, tudna valaki súgni?

Van egy TextBox amibe írok, akkor csak azokat az értékeket jeleníti meg, viszont hibára fut, mert közben egy PictureBox-ban kellene megjeleníteni külön a hozzá tartozó képet..
Együtt nem akar működni a kettő..

Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'TODO: This line of code loads data into the 'Adatbázis1DataSet.Cikkek' table. You can move, or remove it, as needed.
Me.CikkekTableAdapter.Fill(Me.Adatbázis1DataSet.Cikkek)

End Sub

Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged

Dim search As String = "%" + TextBox1.Text + "%"

Me.CikkekTableAdapter.FillBySearchCikkek(Me.Adatbázis1DataSet.Cikkek, search, search)

End Sub

Private Sub DataGridView1_SelectionChanged(sender As Object, e As EventArgs) Handles DataGridView1.SelectionChanged

Dim imageName As String = DataGridView1.CurrentRow.Cells(3).Value.ToString()
Dim img As Image
img = Image.FromFile(Convert.ToString("D:\Images\") & imageName)
PictureBox1.Image = img

End Sub
End Class

a probléma megkerülése nem segít esetleg?

amíg az egyik fut deaktiválod a másik kódrészletet így keresztreteszelést létrehozva. Netán az textbox objektet "disable"-re állítod, ha van ilyen funkciója, miután pedig lefutott a kép manipuláció újra enabled. Tudom nem szép megoldás, de sajnos jobb ötletem nincs. VB6-ban dolgozol?

Mi a hibaüzenet?

Egy ötlet: csinálsz egy timert, amit akkor kapcsolsz be, amikor a textbox lostfocus van, akkor a tick-ben feltöltöd a picturebox-ot és kikapcsolod a timert.

"Debugging is like being the detective in a crime movie where you're also the murderer."

Szép napot! Nagyon, nagyon kezdő vagyok a Visual Basic-ben, de egy konkrét feladatot szeretnék megoldani, ezen keresztül szeretnék ismerkedni vele. 6-os LOTTO-n szeretnék tippelni mégpedig úgy, hogy a mezőkön sohase ismétlődjenek a számok. A 45 számhoz 7 teljes mező kell + 1 a maradék 3 számnak, de nem ez a lényeg, mert újabb 45 is lehetne. Ezt MSExcel-ben el tudtam készíteni, nagyon jól működik, de Visual Basic-ben is szeretném. VB6-os programmal rendelkezem. Köszönöm a válaszokat. Üdv.: Joe

LEGO-ból bármit megépíteni, csak idő kérdése.

+ (#2880) Ispy köszönöm a javaslatokat! VB.net lenne. Most ismerkedem vele, eddig excelben próbálgattam írogatni..küzdök..
úgy tűnik ezzel jó lehet:
Try

Dim search As String = "%" + TextBox1.Text + "%"

Me.TörzsTableAdapter.FillByKereses(Me.TörzsDataSet.Törzs, search, search, search)

Dim imageName As String = DataGridView1.CurrentRow.Cells(3).Value.ToString()
Dim img As Image
img = Image.FromFile(Convert.ToString("D:\Images\") & imageName)
PictureBox1.Image = img

Catch ex As Exception



End Try

Sziasztok!
Excel makró témában szeretnék segítséget kérni.

Van 4db munkalapom: Alap, Összefűz, Kiegészít, Kész
Minden cella szöveget tartalmaz.
Az Alap munkalapon csak az A oszlopban vannak adatok.
Az Összefűz lapon az A1 és az A3 cella foglalt (fix), az A2-be (változó) kellene másolni az Alap lapról a tartalmat, cellánként.
Beillesztés után a 3 cellát összefűzni (szóköz nélkül) egy új cellába, majd ezt az új tartalmat továbbküldeni a Kész munkalap A oszlopába, az első üres cellába.
Mindezt addig kellene csinálni (az Összefűz lap A2 celláját felülírva az új tartalommal), ameddig az Alap munkalap A oszlopában üres cellához nem ér.
Ha ez megtörtént, a Kiegészít munkalap A1-A16 cellákat kellene bemásolni a Kész munkalap következő, A oszlopban lévő, üres celláiba.

Nagyon szépen köszönöm, ha valaki lesz olyan kedves, és szán rá egy kis időt, energiát, hogy kisegítsen!

Szerk: fontos lehet, Office 2010 Prof. Plus, amivel rendelkezem.

[ Szerkesztve ]

Szia!

Én így oldanám meg, viszont a Do While-ban lévő első két sort én elhagynám, az ha nincs miértje, szerintem felesleges. Illetve a "3 cellát összefűzni (szóköz nélkül)" arra utalt, hogy a cellák közt ne legyen szünet vagy a tartalmukban?
Ha a tartalmukban, akkor vedd ki a kommentet a ' szóköz eltávolítása:

Sub main()

Application.ScreenUpdating = False

Dim usorKesz, alapSor As Long
usorKesz = Sheets("Kész").Range("A" & Rows.Count).End(xlUp).Row
alapSor = 1

Sheets("Alap").Select

Do While (Cells(alapSor, 1) <> "")
Cells(alapSor, 1).Copy
Sheets("Összefűz").Range("A2").PasteSpecial
Sheets("Kész").Cells(usorKesz + alapSor, 1) = Sheets("Összefűz").Range("A1") & _
Sheets("Összefűz").Range("A2") & Sheets("Összefűz").Range("A3")
' szóköz eltávolítása:
'Sheets("Kész").Cells(usorKesz + alapSor, 1).Replace What:=" ", Replacement:=""
alapSor = alapSor + 1
Loop

Sheets("Kiegészít").Range("A1:A16").Copy
Sheets("Kész").Range("A" & usorKesz + alapSor).PasteSpecial

Application.ScreenUpdating = True

End Sub

erre gondoltál?

"Az agy olyan, mint az ejtőernyő: csak akkor működik, ha nyitott." (Thomas Dewar)

Nagyon köszönöm a segítséget, pont erre gondoltam!
Ha másolás helyett inkább kivágást szeretnék, akkor a Copy helyett mehet mindenhova Cut, ugye?
A tartalomban nem szerettem volna szóközt, úgyhogy kivettem a megjegyzést.

Szerk: Közben lázasan kerestem a hibát a saját művemben, jelzem, megtaláltam Félreértettelek, és az egyes tartalmak között nem szerettem volna szünetet, gondolom így értetted, hogy a cellák között. Tehát mégse kell az a sor

[ Szerkesztve ]

Ha törölni szeretnéd a tartalmat, másképp oldalán meg, a while ciklust módosítanám
, úgy hogy amit kimásolt azt törölje és addig menjen a ciklus míg a cella tartalma nem üres, de most telóról vagyok, majd délután átírom.

"Az agy olyan, mint az ejtőernyő: csak akkor működik, ha nyitott." (Thomas Dewar)

nézd meg ezt:

Sub main()

Application.ScreenUpdating = False

Dim usorKesz, alapSor As Long
usorKesz = Sheets("Kész").Range("A" & Rows.Count).End(xlUp).Row
alapSor = 1

Sheets("Alap").Select

Do While (Cells(1, 1) <> "")
Cells(1, 1).Copy
Sheets("Összefűz").Range("A2").PasteSpecial
Sheets("Kész").Cells(usorKesz + alapSor, 1) = Sheets("Összefűz").Range("A1") & _
Sheets("Összefűz").Range("A2") & Sheets("Összefűz").Range("A3")
alapSor = alapSor + 1
Sheets("Alap").Cells(1, 1).Delete
Loop

Sheets("Kiegészít").Range("A1:A16").Copy
Sheets("Kész").Range("A" & usorKesz + alapSor).PasteSpecial
Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub

"Az agy olyan, mint az ejtőernyő: csak akkor működik, ha nyitott." (Thomas Dewar)

Köszi szépen, ki fogom próbálni!

Van egy scriptem, amit total commanderből meghívok egy gombbal, és átnevezi a kijelölt film mappákat Kodi számára emészthetőbb formába. Mit és hova kellene még beszúrnom, hogy rögtön át is helyezze az "f:\!Film\" mappába az átnevezett mappákat?

Itt a script jelenleg:

Set objRegExp = CreateObject("VBScript.RegExp")
Set WshArg = WScript.Arguments
Set FSO = CreateObject("Scripting.FileSystemObject")
file_name=""
new_file_name=""
flag=False
objRegExp.Pattern=WshArg.Item(1)
If WshArg.Count>1 Then
If FSO.FileExists(WshArg.Item(0)) Then
Set File = FSO.GetFile(WshArg.Item(0))
set TextStream = File.OpenAsTextStream(1)
While Not TextStream.AtEndOfStream
is_File=False
file_name=TextStream.ReadLine()
If FSO.FileExists(file_name) Then
is_File=True
End If
If is_File Then
Set File = FSO.GetFile(file_name)
Else
Set File = FSO.GetFolder(file_name)
End If
new_file_name=replace(objRegExp.Replace(FSO.GetBaseName(file_name), "$1 ($2)"),"."," ")
If is_File Then
new_file_name=new_file_name+"."+FSO.GetExtensionName(file_name)
End If
if is_File and not FSO.FileExists(new_file_name) Then
flag=True
ElseIf not is_File and not FSO.FolderExists(new_file_name) Then
flag=True
End If
if flag Then
File.Name=new_file_name
Else
msgbox "File/Folder " & new_file_name & " already exist. Can't rename ..."
End If
Wend
End If
End If

set fs = CreateObject("Scripting.FileSystemObject")
set folder = fs.GetFolder(path)
folder.Move newPath

forrás

"Debugging is like being the detective in a crime movie where you're also the murderer."

Köszi, ezt már próbáltam, sajnos erre a sorra azt írja:

Érvénytelen eljáráshívás vagy argumentum: 800A0005
set folder = fs.GetFolder(path)

Ezzel az argumentummal indul amúgy a script az átnevezés miatt: %F (\w*\d{0,3})\.(\d{4}).*

Fentiekkel kiegészített script:

Set objRegExp = CreateObject("VBScript.RegExp")
Set WshArg = WScript.Arguments
Set FSO = CreateObject("Scripting.FileSystemObject")

set fs = CreateObject("Scripting.FileSystemObject")
set folder = fs.GetFolder(path)



file_name=""
new_file_name=""
flag=False
objRegExp.Pattern=WshArg.Item(1)
If WshArg.Count>1 Then
If FSO.FileExists(WshArg.Item(0)) Then
Set File = FSO.GetFile(WshArg.Item(0))
set TextStream = File.OpenAsTextStream(1)
While Not TextStream.AtEndOfStream
is_File=False
file_name=TextStream.ReadLine()
If FSO.FileExists(file_name) Then
is_File=True
End If
If is_File Then
Set File = FSO.GetFile(file_name)
Else
Set File = FSO.GetFolder(file_name)
End If
new_file_name=replace(objRegExp.Replace(FSO.GetBaseName(file_name), "$1 ($2)"),"."," ")
If is_File Then
new_file_name=new_file_name+"."+FSO.GetExtensionName(file_name)
End If
if is_File and not FSO.FileExists(new_file_name) Then
flag=True
ElseIf not is_File and not FSO.FolderExists(new_file_name) Then
flag=True
End If
if flag Then
File.Name=new_file_name
Else
msgbox "File/Folder " & new_file_name & " already exist. Can't rename ..."
End If
Wend
End If
End If

folder.Move "F:\Filmek\"

Próbáltam most ide-oda rakosgatni vagy beleépíteni a getfolder-t oda ahol már van egy getfile vagy getfolder, de ezzel sem működik, itt a Set Folder = FSO.GetFile(path) nem tetszik neki:

Set objRegExp = CreateObject("VBScript.RegExp")
Set WshArg = WScript.Arguments
Set FSO = CreateObject("Scripting.FileSystemObject")

file_name=""
new_file_name=""
flag=False
objRegExp.Pattern=WshArg.Item(1)
If WshArg.Count>1 Then
If FSO.FileExists(WshArg.Item(0)) Then
Set File = FSO.GetFile(WshArg.Item(0))
set TextStream = File.OpenAsTextStream(1)
While Not TextStream.AtEndOfStream
is_File=False
file_name=TextStream.ReadLine()
If FSO.FileExists(file_name) Then
is_File=True
End If
If is_File Then
Set File = FSO.GetFile(file_name)
Set Folder = FSO.GetFile(path)
Else
Set File = FSO.GetFolder(file_name)
Set Folder = FSO.GetFolder(path)
End If
new_file_name=replace(objRegExp.Replace(FSO.GetBaseName(file_name), "$1 ($2)"),"."," ")
If is_File Then
new_file_name=new_file_name+"."+FSO.GetExtensionName(file_name)
End If
if is_File and not FSO.FileExists(new_file_name) Then
flag=True
ElseIf not is_File and not FSO.FolderExists(new_file_name) Then
flag=True
End If
if flag Then
File.Name=new_file_name
Else
msgbox "File/Folder " & new_file_name & " already exist. Can't rename ..."
End If
Wend
End If
End If

folder.Move "F:\Filmek\"

[ Szerkesztve ]

Szerintem a Path helyére az eredeti könyvtár helyét kell beírni, amit mozgatni szeretnél, mint alul a move esetében is megadtad.

[ Szerkesztve ]

"Debugging is like being the detective in a crime movie where you're also the murderer."

Ömm, nem hiszem, vagyis nem tudom, nem nagyon értek hozzá, jelenleg a script 1 kattintással amin épp van kijelölés szerkeszti és átnevezi a fájl/mappa nevét. Én csak tovább szeretném automatizálni, hogy a kész fájlt/mappát áthelyezze "f:\Filmek" mappába, hogy Kodi kezelhesse magának. Gondolom VBSnél is van getpath jellegű dolog, hogy tudja mi lett az új elérés, és ezt a mappát helyezze át a statikus "F:\Filmek" mappába.

Tehát amikor készen van a mappa átnevezése, akkor getfolder("átnevzett mappa elérési útja"), utána move "új elérési útvonal".

A getfolder nem csinál mást, mint hozzáférhetővé tesz neked egy foldert, hogy utána például átnevezzed, áthelyezzed.

"Debugging is like being the detective in a crime movie where you're also the murderer."

Sziasztok,

Nem tudom, hogy jó helyre írok-e, de WPS Office topicot nem találtam.
Volna egy Huawei M2.10-es laptopom, amin van WPS Office. Rajta Calc (excel). Az lenne a kérdésem, hogy lehet-e valamilyen formában VisualBasic-et kapcsolni ehhez?

Igazából Az jó lenne, ha lehetne, mert megspórolna a dolog egy laptop vásárlást.

Az ügyvédem nélkül nem írok alá semmit...

Fogalmam sincs, de erősen meglepődnék, ha lehetne.

Én kérek elnézést!

Ezt somorúan hallom...

Akkor marad az Androidos Excel és office 365 előfizetés vagy egy laptop...

Az ügyvédem nélkül nem írok alá semmit...

Sziasztok,

2db VBScript-tel szeretnék egy csv-t vagy egy txt filet feltölteni.
Az elsö VBScriptnek mindig egy új sorba kell írni a cuccost, a második Scriptnek mindig az utolsó sor végére.

Hogyan tudom ezt megoldani?

Elöre is köszönöm a segitseget

a szöveges fájlnak mindegy mi a kiterjesztése, csak a meghíváskor azt írd be.

ha előtte valamit manipulálsz benne:
Új sor : text + vbNewLine
ha nem szeretnél új sort értelemszerűen nem írod bele.

ha csak megnyitod írásra: write/writeline

2 Script 2 külön fájlba ír? egyik csv másik txt? Ha nem akkor a szinkronizáció gondot okozhat.

A szöveges fájl meghívása...
[link] 24. oldal

ha kérdésed van állok rendelkezésedre

[ Szerkesztve ]

Sziasztok!

Kellene egy kis segítség Excel makróban
Nagyon kezdő szinten vagyok
Van egy kész működő függvényem,amivel jelenleg használom a táblázatomat,de jobban szeretném ezt makróval futtatni,mivel jelenleg minden egyes megnyitáskor a legelejétől lefuttatja pedig nekem csak az első üres sortól kellene.
A függvényem az alábbi:
=INDEX('\\Hubudr99102dat\mf\MF3\FEMSZERK_TERMELES\Fémszerkezet\2015.08.01_Komponens_és_szekrény_gyártás\Tervező\2017\[Tervező_2017.xlsm]Planner'!$I$4:$I$5000;HOL.VAN(A4;'\\Hubudr99102dat\mf\MF3\FEMSZERK_TERMELES\Fémszerkezet\2015.08.01_Komponens_és_szekrény_gyártás\Tervező\2017\[Tervező_2017.xlsm]Planner'!$A$4:$A$5000;0))

A fenti függvénybe egy hiba van,hogy ha nincs adat a cellában akkor "01.00" ír a cellába,pedig akkor jobb lenne,ha üresbe hagyná.
Azt szeretném,ha megkeresné az első olyan cellát a 'K'-oszlopba,ami üres és ugyan abba a sorba az 'A'-oszlopba is van adat és innentől futtatná le a függvényemet.

Segítségeteket előre is köszönöm!

[ Szerkesztve ]