question, I added four variable and can not be set name for G. How to do it?
I've increased the range:
. Range ("B15: B18")
It takes G directly bleow Z
Sub aaa()
Dim Wks As Worksheet
Dim i As Byte
With ThisWorkbook.Worksheets("table Z")
Dim OstW As Long: OstW = .Cells(Rows.Count, 4).End(xlUp).Row
If OstW > 14 Then
.Range("B14:E" & OstW).ClearContents
End If
.Range("D14:E14").Value = Array("A", "B")
.Range("B15:B18").Value = Application.Transpose(Array("X", "Y", "Z", "G"))
OstW = .Cells(Rows.Count, 4).End(xlUp).Row + 1
For i = 1 To 4
For Each Wks In ThisWorkbook.Worksheets
If IsNumeric(Wks.Name) Then
If i = 1 Then
Wks.Range("D15:E15").Copy .Range("D" & OstW)
.Range("C" & OstW).Value = Wks.Name
.Rows(OstW + 1).Insert Shift:=xlDown
OstW = OstW + 1
ElseIf i = 2 Then
Wks.Range("D19:E19").Copy .Range("D" & OstW + 1)
.Range("C" & OstW + 1).Value = Wks.Name
.Rows(OstW + 2).Insert Shift:=xlDown
OstW = OstW + 1
ElseIf i = 3 Then
Wks.Range("D23:E23").Copy .Range("D" & OstW + 2)
.Range("C" & OstW + 2).Value = Wks.Name
OstW = OstW + 1
ElseIf i = 4 Then
Wks.Range("D27:E27").Copy .Range("D" & OstW + 3)
.Range("C" & OstW + 3).Value = Wks.Name
OstW = OstW + 1
End If
End If
Next Wks
Next i
End With
End Sub
I've increased the range:
. Range ("B15: B18")
It takes G directly bleow Z
Sub aaa()
Dim Wks As Worksheet
Dim i As Byte
With ThisWorkbook.Worksheets("table Z")
Dim OstW As Long: OstW = .Cells(Rows.Count, 4).End(xlUp).Row
If OstW > 14 Then
.Range("B14:E" & OstW).ClearContents
End If
.Range("D14:E14").Value = Array("A", "B")
.Range("B15:B18").Value = Application.Transpose(Array("X", "Y", "Z", "G"))
OstW = .Cells(Rows.Count, 4).End(xlUp).Row + 1
For i = 1 To 4
For Each Wks In ThisWorkbook.Worksheets
If IsNumeric(Wks.Name) Then
If i = 1 Then
Wks.Range("D15:E15").Copy .Range("D" & OstW)
.Range("C" & OstW).Value = Wks.Name
.Rows(OstW + 1).Insert Shift:=xlDown
OstW = OstW + 1
ElseIf i = 2 Then
Wks.Range("D19:E19").Copy .Range("D" & OstW + 1)
.Range("C" & OstW + 1).Value = Wks.Name
.Rows(OstW + 2).Insert Shift:=xlDown
OstW = OstW + 1
ElseIf i = 3 Then
Wks.Range("D23:E23").Copy .Range("D" & OstW + 2)
.Range("C" & OstW + 2).Value = Wks.Name
OstW = OstW + 1
ElseIf i = 4 Then
Wks.Range("D27:E27").Copy .Range("D" & OstW + 3)
.Range("C" & OstW + 3).Value = Wks.Name
OstW = OstW + 1
End If
End If
Next Wks
Next i
End With
End Sub