Excel fill rows with data from columns in separate sheets - vba

Question

I have an excel file with lots of sheets named "xxA" and "xxB" with xx being consecutive numbers.
Each sheet has the following format:
header1 header2 header3 header 4 header5
ingredient1 description xx 20 g
ingredient2 description xx 34 ml
ingredient3 description xx 56 g
and some other rows at the end.
Basically I want to create a new sheet in which rows 2-27 from column D are copied to a column named "value" and create two new columns with the number in the sheet name and another one with the letter like so:
subject condition ingredient value
21 A ingredient1 20
21 A ingredient2 34
21 A ingredient3 56
21 B ingredient1 34
21 B ingredient2 23
21 B ingredient3 47
...
I tried messing with pivot tables but that doesn't really work. I don't know how to create a VBA, so any direction on that would be great if that is the only way to go.

Answer 1

I think this is what you are looking for. It copies data from worksheets and gets the sheet names split as asked. I have it hard coded to only work for double digit numbers and single letters. Do you have sheets that do not fit that form? If so, I can rework my code!
ORIGINAL:
Sub SheetSummary()
'Make new worksheet with required headers
ActiveWorkbook.Sheets.Add
ActiveSheet.name = "Summary"
range("A1").Value = "subject"
range("B1").Value = "condition"
range("C1").Value = "ingredient"
range("D1").Value = "value"
Dim ws As Worksheet
Dim wsNum As String
Dim wsLetter As String
Dim wsLastRow As Long
Dim sumLastRow As Long
Dim myCell As range
Dim nextOpenRow As Long
'If a worksheet is not the summary, then get the data
For Each ws In Worksheets
If ws.name <> "Summary" Then
wsNum = Left(ws.name, 2)
wsLetter = Right(ws.name, 1)
wsLastRow = ws.Cells(Rows.count, "A").End(xlUp).Row
nextOpenRow = Cells(Rows.count, "A").End(xlUp).Row + 1
ws.range("A2", ws.Cells(wsLastRow, "A")).Copy
range("C" & nextOpenRow).PasteSpecial xlPasteAll
lastRow = Cells(Rows.count, "C").End(xlUp).Row
ws.range("C2", ws.Cells(wsLastRow, "C")).Copy
range("D" & nextOpenRow).PasteSpecial xlPasteAll
Application.CutCopyMode = False
For Each myCell In range("A2", Cells(lastRow, "A"))
If myCell.Value = "" Then
myCell.Value = wsNum
End If
Next myCell
For Each myCell In range("B2", Cells(lastRow, "B"))
If myCell.Value = "" Then
myCell.Value = wsLetter
End If
Next myCell
End If
Next ws
End Sub
EDIT:
Sub SheetSummary()
'Make new worksheet with required headers
ActiveWorkbook.Sheets.Add
ActiveSheet.name = "Summary"
range("A1").Value = "subject"
range("B1").Value = "condition"
range("C1").Value = "ingredient"
range("D1").Value = "value"
Dim ws As Worksheet
Dim wsNum As String
Dim wsLetter As String
Dim wsLastRow As Long
Dim sumLastRow As Long
Dim myCell As range
Dim nextOpenRow As Long
'If a worksheet is not the summary, then get the data
For Each ws In Worksheets
If ws.name <> "Summary" Then
wsNum = Left(ws.name, 2)
wsLetter = Right(ws.name, 1)
wsLastRow = ws.Cells(Rows.count, "A").End(xlUp).Row
nextOpenRow = Cells(Rows.count, "A").End(xlUp).Row + 1
ws.range("A2:A27").Copy
range("C" & nextOpenRow).PasteSpecial xlPasteAll
lastRow = Cells(Rows.count, "C").End(xlUp).Row
ws.range("D2:D27").Copy
range("D" & nextOpenRow).PasteSpecial xlPasteAll
Application.CutCopyMode = False
For Each myCell In range("A2", Cells(lastRow, "A"))
If myCell.Value = "" Then
myCell.Value = wsNum
End If
Next myCell
For Each myCell In range("B2", Cells(lastRow, "B"))
If myCell.Value = "" Then
myCell.Value = wsLetter
End If
Next myCell
End If
Next ws
End Sub

Answer 2

Since you don't know VBA I wouldn't recommend taking that route. You can acheive everything you want using Excel formulas.
To get the name of a sheet use:
=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,255)
Replace "A1" with a reference to the cell on the worksheet you want the name of.
Then use the Left() function to split out the "xx" from the name and then use the Right() function to split out "A"
Hope this helps.