Ger
01-06-2014, 04:20 AM
can somebody help me to adjust this macro. In the past the sheets where named 01 to 52. Now its wk01 to wk52. I cann't find a way to adjust the macro to get it work.
Sub CreateXRef()
Dim i As Long, j As Long, k As Long
Dim LastCol As Long
Dim LastRow As Long
Dim NextRow As Long
Dim FoundRow As Long
Dim sh As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("output").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set sh = Worksheets.Add(before:=Worksheets(1))
sh.Name = "output"
sh.Range("A2").Value = "Name:"
NextRow = 1
For k = 1 To 52
With Worksheets(Format(k, "00"))
For j = 2 To 8
LastRow = .Cells(.Rows.Count, j).End(xlUp).Row
For i = 5 To LastRow
FoundRow = 0
On Error Resume Next
FoundRow = Application.Match(.Cells(i, j).Value2, sh.Columns("B"), 0)
On Error GoTo 0
If FoundRow = 0 Then
NextRow = NextRow + 1
sh.Cells(NextRow, "B").Value2 = .Cells(i, j).Value2
FoundRow = NextRow
End If
LastCol = sh.Cells(FoundRow, sh.Columns.Count).End(xlToLeft).Column
sh.Cells(FoundRow, LastCol + 1).Value2 = CDate(.Cells(4, j).Value2)
sh.Cells(FoundRow, LastCol + 1).NumberFormat = .Cells(4, j).NumberFormat
Next i
Next j
End With
Next k
Application.ScreenUpdating = True
End Sub
Sub CreateXRef()
Dim i As Long, j As Long, k As Long
Dim LastCol As Long
Dim LastRow As Long
Dim NextRow As Long
Dim FoundRow As Long
Dim sh As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("output").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set sh = Worksheets.Add(before:=Worksheets(1))
sh.Name = "output"
sh.Range("A2").Value = "Name:"
NextRow = 1
For k = 1 To 52
With Worksheets(Format(k, "00"))
For j = 2 To 8
LastRow = .Cells(.Rows.Count, j).End(xlUp).Row
For i = 5 To LastRow
FoundRow = 0
On Error Resume Next
FoundRow = Application.Match(.Cells(i, j).Value2, sh.Columns("B"), 0)
On Error GoTo 0
If FoundRow = 0 Then
NextRow = NextRow + 1
sh.Cells(NextRow, "B").Value2 = .Cells(i, j).Value2
FoundRow = NextRow
End If
LastCol = sh.Cells(FoundRow, sh.Columns.Count).End(xlToLeft).Column
sh.Cells(FoundRow, LastCol + 1).Value2 = CDate(.Cells(4, j).Value2)
sh.Cells(FoundRow, LastCol + 1).NumberFormat = .Cells(4, j).NumberFormat
Next i
Next j
End With
Next k
Application.ScreenUpdating = True
End Sub