from the first pic how do you loop thru the offset data then copy to another sheet result is second pic
Not sure if this is what you wanted.
Sub getemail()
Dim i As Integer
Dim Ws_Pic1 As Object, Ws_Pic2 As Object
'Ws_Pic1 --> original data
'Ws_Pic2 --> result
Set Ws_Pic1 = ThisWorkbook.Sheets("Sheet1")
Set Ws_Pic2 = ThisWorkbook.Sheets("Sheet1 (2)")
For i = 1 To Ws_Pic1.Range("B" & Rows.Count).End(xlUp).Row
If Ws_Pic1.Range("B" & i).Value2 <> "" Then
If Ws_Pic2.Range("F1").Value2 = "" Then
Ws_Pic2.Range("A1").Value2 = Ws_Pic1.Range("B" & i).Offset(0, -1).End(xlUp).Value2
Ws_Pic2.Range("F1").Value2 = Ws_Pic1.Range("B" & i).Value2
Ws_Pic2.Range("F1").Offset(0, 1).Value2 = Ws_Pic1.Range("B" & i).Offset(0, 1).Value2
Ws_Pic2.Range("F1").Offset(0, 2).Value2 = Ws_Pic1.Range("B" & i).Offset(0, 2).Value2
Ws_Pic2.Range("F1").Offset(0, 3).Value2 = Ws_Pic1.Range("B" & i).Offset(0, 3).Value2
Else
Ws_Pic2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value2 = Ws_Pic1.Range("B" & i).Offset(0, -1).End(xlUp).Value2
Ws_Pic2.Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value2 = Ws_Pic1.Range("B" & i).Value2
Ws_Pic2.Range("F" & Rows.Count).End(xlUp).Offset(0, 1).Value2 = Ws_Pic1.Range("B" & i).Offset(0, 1).Value2
Ws_Pic2.Range("F" & Rows.Count).End(xlUp).Offset(0, 2).Value2 = Ws_Pic1.Range("B" & i).Offset(0, 2).Value2
Ws_Pic2.Range("F" & Rows.Count).End(xlUp).Offset(0, 3).Value2 = Ws_Pic1.Range("B" & i).Offset(0, 3).Value2
End If
End If
Next i
End Sub
Related
I have written multiple scripts in VBA for multiple Buttons in an excel sheet to automate a process for the same. All I want is for someone to review my code and critic its cleanliness. It would be very helpful to have suggestions on how to make the code cleaner and optimize the process.
Private Sub CommandButton1_Click()
Dim last_row As Double
Call ModelwithEach
last_row = Range("F" & Rows.Count).End(xlUp).Row
Range("AM1").Value = "WithEach"
Range("AM3:AM" & last_row).Formula = "=F3&R3"
Range("L3:L" & last_row).Formula = "=VLOOKUP(AM3,'[Indemed Datafeed Latest.xlsm]Sheet1'!$A:$B,2,0)"
Range("M3:M" & last_row).Formula = "=VLOOKUP(AM3,'[Indemed Datafeed Latest.xlsm]Sheet1'!$A:$K,11,0)"
Range("N3:N" & last_row).Formula = "=VLOOKUP(AM3,'[Indemed Datafeed Latest.xlsm]Sheet1'!$A:$H,8,0)"
Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Clear
End Sub
Private Sub CommandButton2_Click()
Dim last_row As Double
last_row = Range("U" & Rows.Count).End(xlUp).Row
Range("V3:V" & last_row).Formula = "=VLOOKUP(U3,'[current pricing sheet july 2019 - Copy.xlsx]Sheet1'!$A:$B,2,0)"
Range("W3:W" & last_row).Formula = "=VLOOKUP(U3,'[current pricing sheet july 2019 - Copy.xlsx]Sheet1'!$A:$B,2,0)"
Dim Shipping As Double
Dim i As Double
Shipping = Range("W" & Rows.Count).End(xlUp).Row
For i = 3 To Shipping
If Range("W" & i).Value >= 70 Then
Range("X" & i).Value = "Free Shipping"
Range("Y" & i).Value = 0
Range("Z" & i).Value = "Yes"
ElseIf Range("W" & i).Value <= 69.99 Then
Range("X" & i).Value = "Really Flat"
Range("Y" & i).Value = 6.99
Range("Z" & i).Value = "No"
Else
End If
Next i
End Sub
Private Sub CommandButton3_Click()
Dim last_row As Double
Dim i As Double
last_row = Range("F" & Rows.Count).End(xlUp).Row
For i = 3 To last_row
If Range("N" & i).Value > Range("K" & i).Value Then
Range("G" & i).Value = "McKesson"
ElseIf Range("K" & i).Value > Range("N" & i).Value Then
Range("G" & i).Value = "Independence Medical"
End If
Next i
Range("XFD2:XFD" & last_row).Formula = "=UPPER(LEFT(Q2,2))"
Range("S3:S" & last_row).Formula = "=PROPER(VLOOKUP(F3,'MediUSA wound Care Feed.csv'!$A:$G,7,0))"
For i = 2 To last_row
Range("T" & i).Value = Range("R" & i) & "/" & Range("S" & i)
Next i
'If Range("M2:M" & last_row).Value = "Case" Then
' Range("B2:B" & last_row).Formula = "=UPPER(LEFT(Q2,2))&F2"
' Range("B2:B" & last_row).Value = Range("B" & i).Value & "-CS"
'ElseIf Range("M" & i) = "Box" Then
' Range("B2:B" & last_row).Formula = "=UPPER(LEFT(Q2,2))&F2"
' Range("B" & i).Value = Range("B" & i).Value & "-BX"
' End If
' Next i
For i = 2 To last_row
If Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Case" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-CS"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Each" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & ""
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Box" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-BX"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Pair" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-PR"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Package" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-PK"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Carton" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-CT"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Dozen" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-DZ"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Vial" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-VL"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Roll" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-RL"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Tray" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-TR"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Can" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-CN"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Jar" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-JR"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Bag" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-BG"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Gallon" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-GL"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Set" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-ST"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Kit" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-KT"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Gross" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-GR"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Pad" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-PD"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Tube" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-TU"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Sleeve" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-SL"
Else
Range("B" & i).Value = ""
End If
Next i
End Sub
Private Sub CommandButton4_Click()
Dim last_row As Double
Dim i As Double
last_row = Range("F" & Rows.Count).End(xlUp).Row
For i = 2 To last_row
If InStr(1, UCase(Range("B" & i)), "-MI") <> 0 Then
Range("F" & i).Value = Range("F" & i + 1)
Range("G" & i).Value = Range("G" & i + 1)
Range("U" & i).Value = Range("U" & i + 1)
Range("V" & i).Value = Range("V" & i + 1)
Range("W" & i).Value = Range("W" & i + 1)
Range("X" & i).Value = Range("X" & i + 1)
Range("Y" & i).Value = Range("Y" & i + 1)
Range("Z" & i).Value = Range("Z" & i + 1)
Range("D" & i).Value = "Parent Matrix Item"
Range("A" & i & ":AL" & i).Interior.Color = vbYellow
Range("A" & i - 1 & ":AL" & i - 1).Value = Range("A1:AL1").Value
Range("A" & i - 1 & ":AL" & i - 1).Interior.Color = vbGreen
Range("AE" & i).Value = "<p>Warranty and stuff</p>"
Range("AF" & i).Value = "<p>Return Policy</p>"
Range("AA" & i).Value = Range("C" & i) & "|" & Range("F" & i)
Range("Q" & i).Value = Range("Q" & i + 1)
Range("E" & i + 1 & ":E" & last_row).Value = Range("A" & i)
Range("E" & i).Value = " "
Else
Range("D" & i).Value = "Child Matrix Item"
End If
Next i
Range("AG2:AG" & last_row).Formula = "Supply Item"
End Sub
Private Sub CommandButton5_Click()
Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Clear
End Sub
Private Sub CommandButton6_Click()
Dim last_row As Double
last_row = Range("F" & Rows.Count).End(xlUp).Row
Range("H3:H" & last_row).Formula = "=VLOOKUP(AM3,'[Mck Merge Sheet.xlsx]Sheet1'!$A:$D,4,0)"
Range("J3:J" & last_row).Formula = "=VLOOKUP(AM3,'[Mck Merge Sheet.xlsx]Sheet1'!$A:$H,8,0)"
Range("K3:K" & last_row).Formula = "=VLOOKUP(AM3,'[Mck Merge Sheet.xlsx]Sheet1'!$A:$J,10,0)"
Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Clear
End Sub
Any word of advice will be much appreciated and thanked for.
I have a workbook in which I track stats on projects. I have a function attached to a button that copies the 'Template' worksheet and gives it a name I enter.
I have a worksheet within the same workbook named 'Statistics', where I track totals and averages of certain cells within all the worksheets for each project.
No problem adding the new worksheet name to the formulas which only add values together.
However, I don't know how to format something which will add the new worksheet name (and cell name) to the AVERAGE() function.
Here is the Macro so far:
Sub btnAdd_Click()
Dim strFormula As String
strBookName = ""
frmAddBook.Show
If Len(strBookName) <> 0 Then
'Add the sheet...
ActiveWorkbook.Sheets("Template").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = strBookName
ActiveSheet.Cells(1, 2) = strBookName
ActiveSheet.Cells(1, 1).Activate
'Modify the statisics totals to include those from the new sheet
With Sheets("Statistics")
'These are only adding to a formula which totals the cell values from each worksheet and this works
.Cells(6, 4).Formula = .Cells(6, 4).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!I4"
.Cells(7, 4).Formula = .Cells(7, 4).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!I3"
.Cells(8, 4).Formula = .Cells(8, 4).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!B5"
.Cells(9, 4).Formula = .Cells(9, 4).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!B4"
.Cells(13, 4).Formula = .Cells(13, 4).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!B7"
'THESE ARE THE CELLS THAT I WANT TO USE THE AVERAGE FUNCTION AND APPEND WITH EACH NEW WORKSHEET NAME
.Cells(5, 10).Formula = .Cells(5, 10).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!L1"
.Cells(6, 10).Formula = .Cells(6, 10).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!L5"
.Cells(7, 10).Formula = .Cells(7, 10).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!L6"
End With
End If
End Sub
I'd really appreciate any help. Thanks!
Might be easier to instead have an "updateStats" method which builds the formulas from scratch, using any worksheet in the workbook not named "Template" or "Statistics": that way you can also delete a project and refresh the formulas.
Eg: call this after adding or removing a worksheet
Sub UpdateStats()
Dim ws As Worksheet, nm, arrSkip, frm, sep
arrSkip = Array("Template", "Statistics") 'add other sheet here
frm = ""
sep = ""
For Each ws In ThisWorkbook.Worksheets
nm = ws.Name
'check name before processing
If IsError(Application.Match(nm, arrSkip, 0)) Then
frm = frm & sep & "'" & nm & "'!<C>"
sep = ","
End If
Next ws
With ThisWorkbook.Sheets("Statistics")
If Len(frm) > 0 Then 'any sheets to summarize?
.Cells(6, 4).Formula = "=SUM(" & Replace(frm, "<C>", "I4") & ")"
.Cells(7, 4).Formula = "=SUM(" & Replace(frm, "<C>", "I3") & ")"
.Cells(8, 4).Formula = "=SUM(" & Replace(frm, "<C>", "B5") & ")"
.Cells(9, 4).Formula = "=SUM(" & Replace(frm, "<C>", "B4") & ")"
.Cells(5, 10).Formula = "=AVERAGE(" & Replace(frm, "<C>", "L1") & ")"
.Cells(6, 10).Formula = "=AVERAGE(" & Replace(frm, "<C>", "L5") & ")"
.Cells(7, 10).Formula = "=AVERAGE(" & Replace(frm, "<C>", "L6") & ")"
Else
.Cells(6, 4).Resize(4, 1).Clear
.Cells(5, 10).Resize(3, 1).Clear
End If
End With
End Sub
I'm trying to condense the following code. I'm thinking a loop function may work, but it also may not because of the difference in VBA item. Any insight?
If CheckBox1.Value = True _
Then
Range("P" & Rows.Count).End(xlUp).Offset(0, 0).Value = "Y"
Else
Range("P" & Rows.Count).End(xlUp).Offset(0, 0).Value = "N"
End If
If CheckBox2.Value = True _
Then
Range("Q" & Rows.Count).End(xlUp).Offset(0, 0).Value = "Y"
Else
Range("Q" & Rows.Count).End(xlUp).Offset(0, 0).Value = "N"
End If
If CheckBox3.Value = True _
Then
Range("R" & Rows.Count).End(xlUp).Offset(0, 0).Value = "Y"
Else
Range("R" & Rows.Count).End(xlUp).Offset(0, 0).Value = "N"
End If
If CheckBox4.Value = True _
Then
Range("S" & Rows.Count).End(xlUp).Offset(0, 0).Value = "Y"
Else
Range("S" & Rows.Count).End(xlUp).Offset(0, 0).Value = "N"
End If
If CheckBox5.Value = True _
Then
Range("T" & Rows.Count).End(xlUp).Offset(0, 0).Value = "Y"
Else
Range("T" & Rows.Count).End(xlUp).Offset(0, 0).Value = "N"
End If
If CheckBox6.Value = True _
Then
Range("U" & Rows.Count).End(xlUp).Offset(0, 0).Value = "Y"
Else
Range("U" & Rows.Count).End(xlUp).Offset(0, 0).Value = "N"
End If
If CheckBox7.Value = True _
Then
Range("V" & Rows.Count).End(xlUp).Offset(0, 0).Value = "Y"
Else
Range("V" & Rows.Count).End(xlUp).Offset(0, 0).Value = "N"
End If
If CheckBox8.Value = True _
Then
Range("W" & Rows.Count).End(xlUp).Offset(0, 0).Value = "Y"
Else
Range("W" & Rows.Count).End(xlUp).Offset(0, 0).Value = "N"
End If
If CheckBox9.Value = True _
Then
Range("X" & Rows.Count).End(xlUp).Offset(0, 0).Value = "Y"
Else
Range("X" & Rows.Count).End(xlUp).Offset(0, 0).Value = "N"
End If
If CheckBox10.Value = True _
Then
Range("Y" & Rows.Count).End(xlUp).Offset(0, 0).Value = "Y"
Else
Range("Y" & Rows.Count).End(xlUp).Offset(0, 0).Value = "N"
End If
If CheckBox11.Value = True _
Then
Range("Z" & Rows.Count).End(xlUp).Offset(0, 0).Value = "Y"
Else
Range("Z" & Rows.Count).End(xlUp).Offset(0, 0).Value = "N"
End If
If CheckBox12.Value = True _
Then
Range("AA" & Rows.Count).End(xlUp).Offset(0, 0).Value = "Y"
Else
Range("AA" & Rows.Count).End(xlUp).Offset(0, 0).Value = "N"
End If
If CheckBox13.Value = True _
Then
Range("AB" & Rows.Count).End(xlUp).Offset(0, 0).Value = "Y"
Else
Range("AB" & Rows.Count).End(xlUp).Offset(0, 0).Value = "N"
End If
If CheckBox14.Value = True _
Then
Range("AC" & Rows.Count).End(xlUp).Offset(0, 0).Value = "Y"
Else
Range("AC" & Rows.Count).End(xlUp).Offset(0, 0).Value = "N"
End If
Something like this:
Dim i As Long, ws As Worksheet
Set ws = ActiveSheet 'or whatever
For i = 1 To 14
ws.Cells(Rows.Count, "P").Offset(0, i - 1).End(xlUp).Value = _
IIf(Me.Controls("CheckBox" & i).Value = True, "Y", "N")
Next
Shouldn't that .Offset(0, 0) be .Offset(1, 0) though? Or you're just overwriting the value already there.
This is not a full answer - but the bones of a solution could include this structure
Dim xCtrl As Object, dVal As Variant, xRng As Range
For Each xCtrl In Me.Controls
If Left(xCtrl.name, 8) = "CheckBox" Then
dVal = Val(Mid(xCtrl.name, 9))
If dVal >= 1 And dVal < 15 Then
If xCtrl.Value = True then
' ComboBox is True ... Update here
Else
' ComboBox is False ... Update here
End If
End If
End If
Next xCtrl
Please help optimize this code if possible to run quicker.
Currently program works as intended but I think their may be a better way to copy/paste data into next empty column besides this lengthy else if statement.
Sub compare()
Dim N
Dim mystr
Dim MyComp
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LastRow
N = Range("A" & i)
mystr = Replace(N, Right(N, 8), "")
If Worksheets("Sheet1").Range("A2:A66000").Find(mystr) Is Nothing Then
Else
Set mystr = Worksheets("Sheet1").Range("A2:A66000").Find(mystr, LookAt:=xlWhole)
cn = mystr.Address
'' Portion of code I wish to optimize
If IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 1)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 1)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 2)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 2)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 3)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 3)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 4)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 4)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 5)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 5)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 6)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 6)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 7)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 7)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 8)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 8)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 9)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 9)
Else
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 10)
End If
End If
Next i
End Sub
Use the Range.End method.
With Worksheets("Sheet1")
.Cells(cn.Row,.Columns.Count).End(xlToLeft).Offset(,1).Value = _
Worksheets("Sheet2").Range("A" & i).Value
End WIth
I have created a VBA code at work for a database which my colleagues and I will use to store data on cases that we are working on. However, when I share my Excel, the macro doesn't automatically work.
For it to work, my colleagues need to go into "Macros" and then change "Macros in:" to "(name of doc)" instead of being able to use the default setting "All Open Workbooks".
Is there a way for me to fix my original macro so when i share it with my colleagues the macro can run without the necessity to make adjustments for every input?
This question may be a bit "elementary" in this forum, but would be highly appreciative of any help.
Thanks!
p.s. Please let me know if you need any more information to diagnose this problem.
Private Sub CommandButton1_Click()
Range("A1").Value = Range("A1").Value + 1
End Sub
Sub Macro1()
'
' basic variable types: strings, integers & longs
Dim ws As Worksheet
Dim lastRow As Long
Dim financing As String
Dim compName As String
Dim wrkSht As Worksheet
Dim fortnr As String
Dim lr As Long
Set ws = Sheets("INPUT")
financing = ws.Range("B2").Value
compName = ws.Range("B3").Value
fortnr = compName & "-" & financing
lastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1
ws.Cells(lastRow, "B") = financing
ws.Cells(lastRow, "C") = compName
'
' ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
' ActiveWorkbook.Sheets(Worksheets.Count).Name = compName & "-" & financing
ActiveWorkbook.Worksheets("Template").Copy After:=Worksheets("Template")
ActiveWorkbook.Sheets("Template").Name = compName & "-" & financing
ActiveWorkbook.Sheets(compName & "-" & financing).Visible = xlSheetVisible
ActiveWorkbook.Sheets("Template (2)").Name = "Template"
ActiveWorkbook.Sheets(fortnr).Select
ActiveWorkbook.Sheets(fortnr).Range("C4").Value = financing
ActiveWorkbook.Sheets(fortnr).Range("C5").Value = compName
ws.Cells(lastRow, "D").Formula = "='" & fortnr & "'!$C$7"
ws.Cells(lastRow, "E").Formula = "='" & fortnr & "'!$C$15"
ws.Cells(lastRow, "F").Formula = "='" & fortnr & "'!$C$10"
ws.Cells(lastRow, "G").Formula = "='" & fortnr & "'!$C$11"
ws.Cells(lastRow, "H").Formula = "='" & fortnr & "'!$C$12"
ws.Cells(lastRow, "I").Formula = "='" & fortnr & "'!$C$6"
ws.Cells(lastRow, "J").Formula = "='" & fortnr & "'!$C$14"
ws.Cells(lastRow, "L").Formula = "='" & fortnr & "'!$C$19"
ws.Cells(lastRow, "M").Formula = "='" & fortnr & "'!$C$17"
ws.Cells(lastRow, "N").Formula = "='" & fortnr & "'!$C$21"
ws.Cells(lastRow, "O").Formula = "='" & fortnr & "'!$C$22"
ws.Cells(lastRow, "Q").Formula = "='" & fortnr & "'!$C$25"
ws.Cells(lastRow, "R").Formula = "='" & fortnr & "'!$C$26"
ws.Cells(lastRow, "S").Formula = "='" & fortnr & "'!$C$27"
ws.Cells(lastRow, "T").Formula = "='" & fortnr & "'!$C$28"
ws.Cells(lastRow, "U").Formula = "='" & fortnr & "'!$C$29"
ws.Cells(lastRow, "V").Formula = "='" & fortnr & "'!$C$30"
ws.Cells(lastRow, "W").Formula = "='" & fortnr & "'!$C$31"
ws.Cells(lastRow, "X").Formula = "='" & fortnr & "'!$C$32"
ws.Cells(lastRow, "K").Formula = "='" & fortnr & "'!$C$16"
ws.Cells(lastRow, "P").Formula = "='" & fortnr & "'!$C$20"
'ws.Cells(lastRow, "D") = Sheets(fortnr).Range("B6").Value
'ws.Cells(lastRow, "E") = Sheets(fortnr).Range("B7").Value
'ws.Cells(lastRow, "D") = Sheets(fortnr).Range("B6").Address
'ws.Cells(lastRow, "E") = Sheets(fortnr).Range("B7").Address
ActiveSheet.Hyperlinks.Add Anchor:=ws.Cells(lastRow, 1), Address:="", SubAddress:= _
"'" & fortnr & "'" & "!A1", TextToDisplay:="Check" 'Anchor: the place where the link will be
ActiveSheet.Hyperlinks.Add Sheets(compName & "-" & financing).Range("A1"), "", Sheets("INPUT").Name & "!A1", TextToDisplay:="Back to Input-sheet"
End Sub