PDA

View Full Version : vba for each worksheet loop



squippe
07-29-2016, 04:21 AM
How can I run the following procedures for each sheet:


Sub Test()
'
' Test Macro
' Add titles
'
'
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With

Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True

Range("F1").Select
ActiveCell.FormulaR1C1 = "Konttori nro"

Range("J1").Select
ActiveWindow.SmallScroll Down:=-12
ActiveCell.FormulaR1C1 = "AA"

Range("K1").Select
ActiveCell.FormulaR1C1 = "BB"
Range("L1").Select
ActiveCell.FormulaR1C1 = "CC"
Range("M1").Select
ActiveCell.FormulaR1C1 = "DD"
Range("N1").Select
ActiveCell.FormulaR1C1 = "EE"
Range("P1").Select
ActiveCell.FormulaR1C1 = "FF"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "GG"
Range("X1").Select
ActiveCell.FormulaR1C1 = "HH"
Range("AB1").Select
ActiveCell.FormulaR1C1 = "II"
Range("AC1").Select
ActiveCell.FormulaR1C1 = "Asiakas"
Range("AD1").Select
ActiveCell.FormulaR1C1 = "C/O"
Range("AE1").Select
ActiveCell.FormulaR1C1 = "C/O 2"
Range("AF1").Select
ActiveCell.FormulaR1C1 = "Kieli"
Range("AG1").Select
ActiveCell.FormulaR1C1 = "Postiosoite"
Range("AH1").Select
ActiveCell.FormulaR1C1 = "Postinumero"
Range("AI1").Select
ActiveCell.FormulaR1C1 = "Kaupunki"
Range("AJ1").Select
ActiveCell.FormulaR1C1 = "Maa"
Range("AY1").Select
ActiveCell.FormulaR1C1 = "RR"
Range("AZ1").Select
ActiveCell.FormulaR1C1 = "TT"

SamT
07-29-2016, 09:30 AM
Option Explicit

Sub Test()
Dim Sht As Worksheet

For Each Sht in Worksheets
Rows("1:1").Insert
With Rows("1:1")
.Font.Bold = True
.Borders.LineStyle = xlNone

With.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
End With

With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
.SmallScroll Down:=-12
End With

Range("F1") = "Konttori nro"

Range("J1") = "AA"
Range("K1") = "BB"
Range("L1")= "CC"
Range("M1")= "DD"
Range("N1")= "EE"

Range("P1")= "FF"
Range("Q1")= "GG"

Range("X1")= "HH"

Range("AB1")= "II"
Range("AC1")= "Asiakas"
Range("AD1")= "C/O"
Range("AE1")= "C/O 2"
Range("AF1")= "Kieli"
Range("AG1")= "Postiosoite"
Range("AH1")= "Postinumero"
Range("AI1")= "Kaupunki"
Range("AJ1")= "Maa"

Range("AY1")= "RR"
Range("AZ1")= "TT"
Next Sht
End Sub

p45cal
07-30-2016, 05:15 AM
very similar:
Sub Test()
For Each sht In Worksheets
With sht
.Rows(1).Insert
With .Rows(1)
.Font.Bold = True
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With '.Borders(xlEdgeBottom)
End With '.Rows(1)
.Activate 'needed to split sht.
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With 'ActiveWindow

.Range("F1").Value = "Konttori nro"
.Range("J1:N1").Value = Array("AA", "BB", "CC", "DD", "EE")
.Range("P1:Q1").Value = Array("FF", "GG")
.Range("X1").Value = "HH"
.Range("AB1:AJ1").Value = Array("II", "Asiakas", "C/O", "C/O 2", "Kieli", "Postiosoite", "Postinumero", "Kaupunki", "Maa")
.Range("AY1:AZ1").Value = Array("RR", "TT")
End With 'sht
Next sht
End Sub

squippe
08-01-2016, 03:51 AM
SamT
Hi, thanks for your reply. For some reason your code inserts the titles only on the first sheet. If there is 5 sheets in the excel, it adds 5 times these "titles" on the first sheet...

squippe
08-01-2016, 04:45 AM
Thanks guys for the help, highly appreciated! I continued with p45calīs macro.