I fill out random values in two sheets (Testfall-Input_Vorschlag) and (Testfall-Input_Antrag) out of another sheet (ADMIN_ARB11).
I have 371 rows in sheet (Testfall-Input_Vorschlag) and I have 488 rows in sheet (Testfall-Input_Antrag). I have 859 columns in sheet (ADMIN_ARB11).
I pick a random value from each of the 1st 371 columns (from ADMIN_ARB11) and I put them in the 371 rows in sheet (Testfall-Input_Vorschlag) and then I pick a random value from each of the next 488 columns (from ADMIN_ARB11) and put them in 488 rows in sheet (Testfall-Input_Antrag).
Sub Random_Befüllung_Vorschlag_ARB11()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long, j As Long, LB As Long, UB As Long
Set sh1 = Sheets("Testfall-Input_Vorschlag")
Set sh2 = Sheets("ADMIN_ARB11")
Application.ScreenUpdating = False
For j = 7 To 300
LB = 2
If sh1.Cells(1, j) = "ARB11" Or sh1.Cells(1, j) = "ARB13" Or sh1.Cells(1, j) = "FVB1" Or sh1.Cells(1, j) = "FVB1E" Or sh1.Cells(1, j) = "FVB4" Or sh1.Cells(1, j) = "FVB4E" Then
sh1.Cells(2, j) = sh1.Cells(1, j) & "_Schicht 1"
sh1.Cells(3, j) = "TPL maximale Eingaben"
If j = 7 Then
sh1.Cells(6, j) = 1
Else
sh1.Cells(6, j) = sh1.Cells(6, j - 1) + 1
End If
sh1.Cells(5, j) = "TF " & sh1.Cells(6, j)
sh1.Cells(7, j) = "Test_GE"
sh1.Cells(8, j) = "x"
For i = 11 To 382
UB = sh2.Cells(Rows.Count, i - 10).End(xlUp).Row 'i - 10 controls column in Admin start at col 1.
sh1.Cells(i, j).Value = sh2.Cells(Int((UB - LB + 1) * Rnd + LB), i - 10)
Next
End If
If sh1.Cells(1, j) = vbNullString Then
Exit For
End If
Next
Application.ScreenUpdating = False
End Sub
Sub Random_Befüllung_Antrag_ARB11()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long, j As Long, LB As Long, UB As Long
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Sheets("Testfall-Input_Vorschlag")
Set sh1 = Sheets("Testfall-Input_Antrag")
Set sh2 = Sheets("ADMIN_ARB11")
Application.ScreenUpdating = False
'Testfallinfo in Testfall-Input_Antrag kopieren
For j = 7 To 300
If Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "ARB11" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "ARB13" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB1" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB1E" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB4" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB4E" Then
Union(ws.Cells(1, j), ws.Cells(2, j), ws.Cells(3, j), ws.Cells(4, j), ws.Cells(5, j), ws.Cells(6, j), ws.Cells(7, j), ws.Cells(8, j)).Copy
sh1.Range("IV1").End(xlToLeft).Offset(, 1).PasteSpecial xlValues
End If
LB = 2
If sh1.Cells(1, j) = "ARB11" Then
For i = 13 To 501
UB = sh2.Cells(Rows.Count, i + 364).End(xlUp).Row 'i - 10 controls column in Admin start at col 1.
sh1.Cells(i, j).Value = sh2.Cells(Int((UB - LB + 1) * Rnd + LB), i + 364)
Next
End If
If sh1.Cells(1, j) = vbNullString Then
Exit For
End If
Next j
Application.ScreenUpdating = True
End Sub
It works as expected but it takes 5 min to run the code. How can I optimize this?