See if this works for you
Sub t()
Dim sh As Worksheet, txt1 As String, txt2 As String
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Control" And sh.Name <> "Injured" Then
txt1 = "Variable_3_" & sh.Range("B1").Value
txt2 = "Variable_7_" & sh.Range("B1").Value
If sh.Range("B2") = "Cont" Then
If Sheets("Control").Range("A1") = "" Then
Sheets("Control").Range("A1") = txt1
Intersect(sh.UsedRange.Offset(2), sh.Columns("F")).Copy Sheets("Control").Range("A3")
Sheets("Control").Range("B1") = txt2
Intersect(sh.UsedRange.Offset(2), sh.Columns("J")).Copy Sheets("Control").Range("B3")
Else
Sheets("Control").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1) = txt1
Intersect(sh.UsedRange.Offset(2), sh.Columns("F")).Copy Sheets("Control"). _
Cells(1, Columns.Count).End(xlToLeft).Offset(2)
Sheets("Control").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1) = txt2
MsgBox Intersect(sh.UsedRange.Offset(2), sh.Columns("J")).Address
Intersect(sh.UsedRange.Offset(2), sh.Columns("J")).Copy Sheets("Control"). _
Cells(1, Columns.Count).End(xlToLeft).Offset(2)
End If
ElseIf sh.Range("B2") = "Inj" Then
If Sheets("Injured").Range("A1") = "" Then
Sheets("Injured").Range("A1") = txt1
Intersect(sh.UsedRange.Offset(2), sh.Columns("F")).Copy Sheets("Injured").Range("A3")
Sheets("Injured").Range("B1") = txt2
Intersect(sh.UsedRange.Offset(2), sh.Columns("J")).Copy Sheets("Injured").Range("B3")
Else
Sheets("Injury").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1) = txt1
Intersect(sh.UsedRange.Offset(2), sh.Columns("F")).Copy Sheets("Injured"). _
Cells(1, Columns.Count).End(xlToLeft).Offset(2)
Sheets("Injured").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1) = txt2
Intersect(sh.UsedRange.Offset(2), sh.Columns("J")).Copy Sheets("Injured"). _
Cells(1, Columns.Count).End(xlToLeft).Offset(2)
End If
End If
End If
Next
End Sub
Bookmarks