Sub Macro10()

Dim Lr As Long
Dim icol As Long
Dim nrKoloms As Long
Lr = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Offset(1,
0).Row
nrKoloms =
Application.WorksheetFunction.CountA(Sheets("Questionnaire").Range("C12:L12"))

Application.ScreenUpdating = False
On Error Resume Next
For icol = 1 To nrKoloms Step 1

If Sheets("Questionnaire").Cells(12, 2 + icol).Value = "" Then
Exit Sub
Else

Sheets("Database").Range("A" & Lr + icol - 1) =
Sheets("Questionnaire").Range("C4")
Sheets("Database").Range("B" & Lr + icol - 1) =
Sheets("Questionnaire").Range("B6")
Sheets("Database").Range("C" & Lr + icol - 1) =
Sheets("Questionnaire").Range("F5")
Sheets("Database").Range("D" & Lr + icol - 1) =
Sheets("Questionnaire").Range("F6")
Sheets("Database").Range("E" & Lr + icol - 1) =
Sheets("Questionnaire").Range("L4")
Sheets("Database").Range("F" & Lr + icol - 1) =
Sheets("Questionnaire").Range("L6")

Sheets("Questionnaire").Activate
ActiveSheet.Range(Cells(12, 2 + icol), Cells(33, 2 + icol)).Copy
Sheets("Database").Range("G" & Lr + icol - 1).PasteSpecial
Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False


Sheets("Database").Range("AC" & Lr + icol - 1) =
Sheets("Questionnaire").Range("C38")
Sheets("Database").Range("AD" & Lr + icol - 1) =
Sheets("Questionnaire").Range("C40")
Sheets("Database").Range("AE" & Lr + icol - 1) =
Sheets("Questionnaire").Range("C41")
Sheets("Database").Range("AF" & Lr + icol - 1) =
Sheets("Questionnaire").Range("C42")
Sheets("Database").Range("AG" & Lr + icol - 1) =
Sheets("Questionnaire").Range("C43")
Sheets("Database").Range("AH" & Lr + icol - 1) =
Sheets("Questionnaire").Range("B29")
End If
Next icol

Application.ScreenUpdating = False
End Sub