habe ein Problem mit meinem VBA Code bzw. mit der Loesung des Problems...
Bin noch ein Neuling in der VBA-Welt.
Mein Problem ist es, dass ich von einer Datei mit Infos (siehe Link Sheet:src)
Daten in ein Layout (siehe dst) bekommen moechte. Dabei ist fuer jede Item# ein Sheet mit dem Layout angelegt.
Jetzt moechte ich wenn die Item# von der Datei "src" mit der in der Layout Datei "dst" auf einem der zielsheets(Voreingetragen) uebereinstimmt, bestimmte Daten (siehe Code) aus der selben Zeile der "src" in bestimmte Felder des Layouts uebertragen.
Bitte um Hilfe.
https://www.herber.de/bbs/user/107239.xlsx
Private Sub CommandButton1_Click()
Dim src As Workbook
Dim dst As Workbook
Dim ChFile As Variant
Dim dstFile As Variant
Dim ws As Worksheet
Dim x As Range
dstFile = Application.GetOpenFilename
If dstFile = False Then
MsgBox "Action canceled!"
Exit Sub
End If
Set dst = Workbooks.Open(dstFile)
ChFile = Application.GetOpenFilename
If ChFile = False Then
MsgBox "Action canceled!"
Exit Sub
End If
Set src = Workbooks.Open(ChFile)
dst.Activate
For Each ws In dst.Sheets
Set ws = dst.ActiveSheet
such = ws.Range("y5")
Set x = src.Sheets("Sheet1").Range("B:B").Find(what:=such, Lookat:=xlWhole)
If Not x Is Nothing Then
x = x.Row '-->x wird in src file =dem wert gesetzt
End If
If IsEmpty(dst.ActiveSheet.Range("ap5").Value) = True Then
dst.ActiveSheet.Range("ap5") = src.Sheets("Sheet1").Cells(x, 11)
End If
'Insert Vendor Name
If IsEmpty(dst.ActiveSheet.Range("n6").Value) = True Then
dst.ActiveSheet.Range("n6") = src.Sheets("Sheet1").Cells(x, 12)
End If
'Insert Abbrev. Title
If IsEmpty(dst.ActiveSheet.Range("n7").Value) = True Then
dst.ActiveSheet.Range("n7") = src.Sheets("Sheet1").Cells(x, 13)
End If
'Insert Title row 11
If IsEmpty(dst.ActiveSheet.Range("n11").Value) = True Then
dst.ActiveSheet.Range("n11") = src.Sheets("Sheet1").Cells(x, 14)
End If
'Insert Title row 82
If IsEmpty(dst.ActiveSheet.Range("q82").Value) = True Then
dst.ActiveSheet.Range("q82") = src.Sheets("Sheet1").Cells(x, 14)
End If
'Insert Retail Pack Weight
If IsEmpty(dst.ActiveSheet.Range("t17").Value) = True Then
dst.ActiveSheet.Range("t17") = src.Sheets("Sheet1").Cells(x, 16)
End If
'Insert Retail Pack Width
If IsEmpty(dst.ActiveSheet.Range("ac17").Value) = True Then
dst.ActiveSheet.Range("ac17") = src.Sheets("Sheet1").Cells(x, 17)
End If
'Insert Retail Pack height
If IsEmpty(dst.ActiveSheet.Range("ah17").Value) = True Then
dst.ActiveSheet.Range("ah17") = src.Sheets("Sheet1").Cells(x, 18)
End If
'Insert Retail Pack Depth
If IsEmpty(dst.ActiveSheet.Range("am17").Value) = True Then
dst.ActiveSheet.Range("am17") = src.Sheets("Sheet1").Cells(x, 19)
End If
'Insert Master Carton Weight
If IsEmpty(dst.ActiveSheet.Range("t18").Value) = True Then
dst.ActiveSheet.Range("t18") = src.Sheets("Sheet1").Cells(x, 20)
End If
'Insert Master Carton Width
If IsEmpty(dst.ActiveSheet.Range("ac18").Value) = True Then
dst.ActiveSheet.Range("ac18") = src.Sheets("Sheet1").Cells(x, 21)
End If
'Insert Master Carton height
If IsEmpty(dst.ActiveSheet.Range("ah18").Value) = True Then
dst.ActiveSheet.Range("ah18") = src.Sheets("Sheet1").Cells(x, 22)
End If
'Insert Master Carton Depth
If IsEmpty(dst.ActiveSheet.Range("am18").Value) = True Then
dst.ActiveSheet.Range("am18") = src.Sheets("Sheet1").Cells(x, 23)
End If
'Insert Master Pack Qty
If IsEmpty(dst.ActiveSheet.Range("j27").Value) = True Then
dst.ActiveSheet.Range("j27") = src.Sheets("Sheet1").Cells(x, 26)
End If
'Insert Battery Type
If IsEmpty(dst.ActiveSheet.Range("bf31").Value) = True Then
dst.ActiveSheet.Range("bf31") = src.Sheets("Sheet1").Cells(x, 28)
End If
'Insert Battery Qty
If IsEmpty(dst.ActiveSheet.Range("bk31").Value) = True Then
dst.ActiveSheet.Range("bk31") = src.Sheets("Sheet1").Cells(x, 29)
End If
'Insert DOM Cost
If IsEmpty(dst.ActiveSheet.Range("n34").Value) = True Then
dst.ActiveSheet.Range("n34") = src.Sheets("Sheet1").Cells(x, 31)
End If
'Insert Country of Origin
If IsEmpty(dst.ActiveSheet.Range("b58").Value) = True Then
dst.ActiveSheet.Range("b58") = src.Sheets("Sheet1").Cells(x, 32)
End If
'Insert Contact Vendor Name
If IsEmpty(dst.ActiveSheet.Range("n66").Value) = True Then
dst.ActiveSheet.Range("n66") = src.Sheets("Sheet1").Cells(x, 33)
End If
'Insert Contact Vendor #
If IsEmpty(dst.ActiveSheet.Range("j67").Value) = True Then
dst.ActiveSheet.Range("j67") = src.Sheets("Sheet1").Cells(x, 34)
End If
'Insert Vendor Email
If IsEmpty(dst.ActiveSheet.Range("j68").Value) = True Then
dst.ActiveSheet.Range("j68") = src.Sheets("Sheet1").Cells(x, 35)
End If
'Insert UPC
If IsEmpty(dst.ActiveSheet.Range("f82").Value) = True Then
dst.ActiveSheet.Range("f82") = src.Sheets("Sheet1").Cells(x, 36)
End If
'Insert Copy
If IsEmpty(dst.ActiveSheet.Range("al82").Value) = True Then
dst.ActiveSheet.Range("al82") = src.Sheets("Sheet1").Cells(x, 37)
End If
'Checkbox checked New Setup/Modification
If dst.ActiveSheet.CheckBoxes("Check Box 8").Value = False And dst.ActiveSheet.CheckBoxes(" _
Check Box 9").Value = False And src.Sheets("Sheet1").Cells(x, 9).Value Like "*etup*" Then
dst.ActiveSheet.CheckBoxes("Check Box 8").Value = True
ElseIf dst.ActiveSheet.CheckBoxes("Check Box 8").Value = False And dst.ActiveSheet.CheckBoxes(" _
Check Box 9").Value = False And src.Sheets("Sheet1").Cells(x, 9).Value Like "*cation*" Then
dst.ActiveSheet.CheckBoxes("Check Box 9").Value = True
End If
'Checkbox checked Gender
If dst.ActiveSheet.CheckBoxes("Check Box 3").Value = False Or dst.ActiveSheet.CheckBoxes("Check _
Box 4").Value = False Or dst.ActiveSheet.CheckBoxes("Check Box 11").Value = False And src.Sheets("Sheet1").Cells(x, 25).Value Like "*oys*" Then
dst.ActiveSheet.CheckBoxes("Check Box 3").Value = True
ElseIf dst.ActiveSheet.CheckBoxes("Check Box 3").Value = False Or dst.ActiveSheet.CheckBoxes(" _
Check Box 4").Value = False Or dst.ActiveSheet.CheckBoxes("Check Box 11").Value = False And src.Sheets("Sheet1").Cells(x, 25).Value Like "*irls*" Then
dst.ActiveSheet.CheckBoxes("Check Box 4").Value = True
ElseIf dst.ActiveSheet.CheckBoxes("Check Box 3").Value = False Or dst.ActiveSheet.CheckBoxes(" _
Check Box 4").Value = False Or dst.ActiveSheet.CheckBoxes("Check Box 11").Value = False And src.Sheets("Sheet1").Cells(x, 25).Value Like "*nisex*" Then
dst.ActiveSheet.CheckBoxes("Check Box 11").Value = True
End If
'Checkbox checked Battery reqired
If dst.ActiveSheet.CheckBoxes("Check Box 6").Value = False And src.Sheets("Sheet1").Cells(x, 27) _
.Value Like "*es*" Then
dst.ActiveSheet.CheckBoxes("Check Box 6").Value = True
End If
'Checkbox checked Battery included
If dst.ActiveSheet.CheckBoxes("Check Box 7").Value = False And src.Sheets("Sheet1").Cells(x, 30) _
.Value Like "*es*" Then
dst.ActiveSheet.CheckBoxes("Check Box 7").Value = True
End If
Next
End Sub