|
Hallo,
ich würde gerne per Schleifendurchlauf den gleichen Code in einem zweiten, dritten, usw. Tabellenblatt durchführen. Derzeit habe ich den Code 2 mal im Einsatz, aber würde ihn gerne nur einmal haben und über ein Array das Tabellenblatt selektieren. Allerdings habe ich es nicht hinbekommen. Hier mal der ursprüngliche Code:
'PMAC04_PT Daten werden in temp_JMF zwecks Datenverarbeitung übertragen
x = 5
y = 2
a = Application.WorksheetFunction.CountA(temp_JMVF.Range("A:A")) + 1
b = Application.WorksheetFunction.CountA(TraSy.Range("E:E")) + 1
Do While Sheets("PMAC04_PT").Cells(x, 1) <> "" And Sheets("PMAC04_PT").Cells(x, 6) <> ""
If Sheets("PMAC04_PT").Cells(x, 1).Value = JMVF_Template.Cells(27, 2).Value And Sheets("PMAC04_PT").Cells(x, 7) <> "" Then
temp_JMVF.Cells(a, 1) = Sheets("PMAC04_PT").Cells(x, 5) * 1 'TraSy Ticket Nummer
temp_JMVF.Cells(a, 2) = "PT" 'Metall wird eingetragen
temp_JMVF.Cells(a, 3) = Sheets("PMAC04_PT").Cells(x, 6) 'Menge wird eingetragen
temp_JMVF.Cells(a, 4) = Sheets("PMAC04_PT").Cells(x, 3) * 1 'BP Nummer wird eingetragen
temp_JMVF.Cells(a, 5) = Sheets("PMAC04_PT").Cells(x, 4) 'BP Name wird eingetragen
temp_JMVF.Cells(a, 8) = Sheets("PMAC04_PT").Cells(x, 2) 'PMAC04 Transaction Type wird eingetragen
'Falls Pool Account Transfer, dann Comments mit Daten aus TraSy, aber nur wenn Inhalt in den relevanten Felder sind, füllen
If temp_JMVF.Cells(a, 8) = "PAT" Then
For i = 1 To b
If temp_JMVF.Cells(a, 1).Value = TraSy.Cells(y, 5).Value Then
If TraSy.Cells(y, 10) <> "" Then
temp_JMVF.Cells(a, 6) = TraSy.Range("J1") & ": " & TraSy.Cells(y, 10)
End If
If TraSy.Cells(y, 11) <> "" Then
temp_JMVF.Cells(a, 6) = temp_JMVF.Cells(a, 6) & " " & TraSy.Range("K1") & ": " & TraSy.Cells(y, 11)
End If
If TraSy.Cells(y, 12) <> "" Then
temp_JMVF.Cells(a, 6) = temp_JMVF.Cells(a, 6) & " " & TraSy.Range("L1") & ": " & TraSy.Cells(y, 12)
End If
If TraSy.Cells(y, 13) <> "" Then
temp_JMVF.Cells(a, 6) = temp_JMVF.Cells(a, 6) & " " & TraSy.Range("M1") & ": " & TraSy.Cells(y, 13)
End If
End If
y = y + 1
Next i
End If
'Ende des Comments Füllen mit Daten aus TraSy
If temp_JMVF.Cells(a, 3) > 0 Then
temp_JMVF.Cells(a, 7) = "Receive"
Else: temp_JMVF.Cells(a, 7) = "Debit"
End If
a = a + 1
End If
x = x + 1
y = 2
Loop
'PMAC04_IR Daten werden in temp_JMF zwecks Datenverarbeitung übertragen
x = 5
y = 2
a = Application.WorksheetFunction.CountA(temp_JMVF.Range("A:A")) + 1
b = Application.WorksheetFunction.CountA(TraSy.Range("E:E")) + 1
Do While Sheets("PMAC04_IR").Cells(x, 1) <> "" And Sheets("PMAC04_IR").Cells(x, 6) <> ""
If Sheets("PMAC04_IR").Cells(x, 1).Value = JMVF_Template.Cells(27, 2).Value And Sheets("PMAC04_IR").Cells(x, 7) <> "" Then
temp_JMVF.Cells(a, 1) = Sheets("PMAC04_IR").Cells(x, 5) * 1 'TraSy Ticket Nummer
temp_JMVF.Cells(a, 2) = "IR" 'Metall wird eingetragen
temp_JMVF.Cells(a, 3) = Sheets("PMAC04_IR").Cells(x, 6) 'Menge wird eingetragen
temp_JMVF.Cells(a, 4) = Sheets("PMAC04_IR").Cells(x, 3) * 1 'BP Nummer wird eingetragen
temp_JMVF.Cells(a, 5) = Sheets("PMAC04_IR").Cells(x, 4) 'BP Name wird eingetragen
temp_JMVF.Cells(a, 8) = Sheets("PMAC04_IR").Cells(x, 2) 'PMAC04 Transaction Type wird eingetragen
'Falls Pool Account Transfer, dann Comments mit Daten aus TraSy, aber nur wenn Inhalt in den relevanten Felder sind, füllen
If temp_JMVF.Cells(a, 8) = "PAT" Then
For i = 1 To b
If temp_JMVF.Cells(a, 1).Value = TraSy.Cells(y, 5).Value Then
If TraSy.Cells(y, 10) <> "" Then
temp_JMVF.Cells(a, 6) = TraSy.Range("J1") & ": " & TraSy.Cells(y, 10)
End If
If TraSy.Cells(y, 11) <> "" Then
temp_JMVF.Cells(a, 6) = temp_JMVF.Cells(a, 6) & " " & TraSy.Range("K1") & ": " & TraSy.Cells(y, 11)
End If
If TraSy.Cells(y, 12) <> "" Then
temp_JMVF.Cells(a, 6) = temp_JMVF.Cells(a, 6) & " " & TraSy.Range("L1") & ": " & TraSy.Cells(y, 12)
End If
If TraSy.Cells(y, 13) <> "" Then
temp_JMVF.Cells(a, 6) = temp_JMVF.Cells(a, 6) & " " & TraSy.Range("M1") & ": " & TraSy.Cells(y, 13)
End If
End If
y = y + 1
Next i
End If
'Ende des Comments Füllen mit Daten aus TraSy
If temp_JMVF.Cells(a, 3) > 0 Then
temp_JMVF.Cells(a, 7) = "Receive"
Else: temp_JMVF.Cells(a, 7) = "Debit"
End If
a = a + 1
End If
x = x + 1
Loop
Danke! |