Я очень новичок в кодировании, поэтому, пожалуйста, имейте это в виду. Это код проекта в новой и намного лучшей версии благодаря CDP1802!
Private Sub CommandButton1_Click()
Dim wsSource, wsTarget As Worksheet
Dim i, iLastSource, iRowTarget, count As Long
Dim cell As Range
Set wsSource = Worksheets("Stig Jan")
iLastSource = wsSource.Cells(Rows.count, 1).End(xlUp).Row
Set wsTarget = Worksheets("Laura Jan")
count = 0
With wsSource
iRowTarget = wsTarget.Cells(Rows.count, 1).End(xlUp).Row + 1
For i = 36 To iLastSource
Set cell = .Cells(i, 4)
If cell.Font.Bold = False Then
If cell.Value = "Fælles" Or cell.Value = "Lagt Ud" Then
.Rows(i).Columns("A:H").Copy wsTarget.Range("A" & iRowTarget)
wsTarget.Range("D" & iRowTarget).ClearContents
iRowTarget = iRowTarget + 1
count = count + 1
End If
End If
If cell.Value = "Fælles" Or cell.Value = "Lagt Ud" Then
wsSource.Rows(i).Columns("A:H").Font.Bold = True
End If
Next
iRowTarget = wsTarget.Range("K76").End(xlUp).Row + 1
For i = 36 To iLastSource
Set cell = .Cells(i, 14)
If cell.Font.Bold = False Then
If cell.Value = "Fælles" Or cell.Value = "Lagt Ud" Then
.Rows(i).Columns("K:R").Copy wsTarget.Range("K" & iRowTarget)
wsTarget.Range("N" & iRowTarget).ClearContents
iRowTarget = iRowTarget + 1
count = count + 1
End If
End If
If cell.Value = "Fælles" Or cell.Value = "Lagt Ud" Then
wsSource.Rows(i).Columns("K:R").Font.Bold = True
End If
Next
End With
MsgBox "Done : " & count & " rows copied"
End Sub
Эта часть кода очень хорошо работала для поиска и поиска значения ранее, но у меня возникли проблемы при объединении его с существующим код:
Dim myCell As Range
Set myRange = Worksheets("Laura Jan").Range("A36:S1000")
For Each myCell In myRange
If myCell Like "*STIG*" Then
myCell.Font.Bold = True
End If
Next
Что я делаю не так?