Soemt text
Correct some text and save
[vba]Sub Button1_Click()
Application.ScreenUpdating = False
x = 2
With Worksheets("Sheet1")
Do While .Cells(x, 4) <> ""
'When value in Column "D" changes
If Cells(x, 4) <> Cells(x - 1, 4) Then
If Sheets(Cells(x, 4)) Is Nothing Then
Sheets("template").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Cells(x, 4) 'Sheets(Sheets.Count).Name = isometry
End If
End If
'For every cell in Column "D"
If Cells(x, 1) = "07" And Cells(x, 3) = "GDH" Then
Sheets(Cells(x, 4)).Cells(33, 2) = Sheet1.Cells(x, 4) 'isometry
Sheets(Cells(x, 4)).Cells(33, 28) = Sheet1.Cells(x, 32) 'date
End If
x = x + 1
Loop
End With
Application.ScreenUpdating = True
End Sub[/vba]