Hi all,
I found this excellent macro from a past post, lamentably this work fine for 2 sheets but lamentably
I could not modify to work with 7 sheets...
Please any advice I will gratefull
Regards
The macro is:
Sub TestGridUpdate()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim TestGridFound As Boolean
Dim r As Range
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
' Look for TestGrid worksheet
TestGridFound = False
For Each ws In Worksheets
If ws.Name = "TestGrid" Then TestGridFound = True
Next
'If TestGrid is found then use it else create it
If TestGridFound Then
Set ws3 = ThisWorkbook.Worksheets("TestGrid")
ws3.Cells.Clear
Else
Set ws3 = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
ws3.Name = "TestGrid"
End If
' Copy ws1 to ws3 (TestGrid)
ws3.Range(ws1.UsedRange.Address).Value = ws1.UsedRange.Value
' Add ws2 details to ws3 (TestGrid)
For Each r In ws3.UsedRange.Rows
ID = r.Cells(, 1).Value
iRow = Application.Match(ID, ws2.UsedRange.Columns(1), 0)
ws2.Range("B" & iRow & ":U" & iRow).Copy ws3.Range("Q" & r.Row)
Next
End Sub
I found this excellent macro from a past post, lamentably this work fine for 2 sheets but lamentably
I could not modify to work with 7 sheets...
Please any advice I will gratefull
Regards
The macro is:
Sub TestGridUpdate()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim TestGridFound As Boolean
Dim r As Range
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
' Look for TestGrid worksheet
TestGridFound = False
For Each ws In Worksheets
If ws.Name = "TestGrid" Then TestGridFound = True
Next
'If TestGrid is found then use it else create it
If TestGridFound Then
Set ws3 = ThisWorkbook.Worksheets("TestGrid")
ws3.Cells.Clear
Else
Set ws3 = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
ws3.Name = "TestGrid"
End If
' Copy ws1 to ws3 (TestGrid)
ws3.Range(ws1.UsedRange.Address).Value = ws1.UsedRange.Value
' Add ws2 details to ws3 (TestGrid)
For Each r In ws3.UsedRange.Rows
ID = r.Cells(, 1).Value
iRow = Application.Match(ID, ws2.UsedRange.Columns(1), 0)
ws2.Range("B" & iRow & ":U" & iRow).Copy ws3.Range("Q" & r.Row)
Next
End Sub