Copy a range of an excelsheet one row down for every sheet that contains data

Revision: 63757

at June 5, 2013 00:49 by Hassito

Initial Code

Sub CopyRange()

    Dim oRange As Range
    Dim startColumn As String
    Dim endColumn As String
    Dim rangeStart As Integer
    Dim rangeEnd As Integer
    Dim myBook As Workbook
    Dim sh As Worksheet
    

    Application.ScreenUpdating = False
    
    wk = Sheets("pres").Range("e5")
    startColumn = "D"
    endColumn = "R"
    rangeStart = wk + 2
    rangeEnd = wk + 3
    
    
    Set wb1 = Workbooks("Weekperformance 2013.xlsm")

        
    For Each sh In wb1.Worksheets
        If LCase(Right(sh.Name, 4)) = "data" Then
    
       
        Set oRange = sh.Range(startColumn & rangeStart & ":" & endColumn & rangeStart)
         oRange.Copy
         oRange.Offset(1, 0).PasteSpecial xlPasteAll
         oRange.Offset(0, 0).PasteSpecial Paste:=xlValues
         
        End If
            
      Next sh

Application.ScreenUpdating = True


MsgBox ("Week " & wk + 1 & " is ready , you can start with adding data to the new week")



End Sub

Initial URL

Initial Description

Copy a range of an excelsheet one row down for every sheet that contains data.
This is usefull when you have to add every week new data to a sheet and you want to keep the values of the previous week.

Initial Title

Copy a range of an excelsheet one row down for every sheet that contains data

Initial Tags

Initial Language

Visual Basic

Choose a language for easy browsing: