Loop through multiple sheets, add new sheet to destination workbook. Dest.sheet name same as Source.sheet name.

dilshod_k

Board Regular
Joined
Feb 13, 2018
Messages
76
Hello everyone,

I’ve code that loops through multiple sheets (sheet names are in date format yyyy.mm.dd) in workbook Test.xlsm and the code is supposed to add new sheet to workbook Results.xlsm and give it the same name. I tried to use shtname = ActiveSheet.Name and DestSh.Name = shtname but as I have to do multiple calculations and manipulations with sheets of both source and destination workbooks, I found it difficult to avoid error messages when the new sheet is being added. Is there any other way to give the same name to the added sheet without using ActiveSheet way? Would be grateful for any help.

Thanks in advance.

Dilshod
 

Some videos you may like

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,052
Office Version
  1. 2016
Platform
  1. Windows
Activesheet referred to sheet in workbook Test? Since you loop through all sheets in workbook Test, then why not just refer the it tot he loop variable instead of Activesheet.

NOt sure if I understood the problem right. Maybe you could show code sample for others to understand better.
 

dilshod_k

Board Regular
Joined
Feb 13, 2018
Messages
76
Hello Zot,
Thanks for your message.
The code is too long, it includes other macros downloading data from internet, that is why I did not publish it.
Activesheet refers to Test.xlsm, and as it loops through multiple sheets and their name constantly changes I do not know how to refer to it the loop variable.
Dilshod
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,052
Office Version
  1. 2016
Platform
  1. Windows
Just how do you loop through sheets and how you define the part you said the sheet name between two workbooks are the same
 

dilshod_k

Board Regular
Joined
Feb 13, 2018
Messages
76
I've been able to make it work within one workbook, it adds new sheet with slight modification of the name of the original sheet and then copies data to that sheet. The aim is to add new sheet with identical name to another sheet and copy data there. Please find the code as it follows below.

Rich (BB code):
Sub Test()

'PURPOSE: Determine how many seconds it took for code to completely run
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim StartTime As Double
Dim SecondsElapsed As Double

'Remember time when macro starts
  StartTime = Timer


Dim cell As Range
Dim myfile As String
Dim wb As Workbook
Dim last As Long
Dim DestSh As Worksheet
shtname = ActiveSheet.Name

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


ActiveSheet.Range("A2", Range("B2").End(xlDown)).Copy

Set DestSh = Workbooks("BacktestFile.xlsm").Worksheets.Add
    DestSh.Name = shtname & "T"
    
On Error Resume Next 'MIGHT BE HIDING AN ERROR CAUSING YOUR PROBLEM

ThisWorkbook.Sheets("Sheet1").Activate
ThisWorkbook.Sheets("Sheet1").Range("K1").PasteSpecial
ThisWorkbook.Sheets("Sheet1").Range("L1").Copy
ThisWorkbook.Sheets("Sheet1").Range("S11").PasteSpecial
ThisWorkbook.Sheets("Sheet1").Range("S12").Value = ThisWorkbook.Sheets("Sheet1").Range("S11").Value + 30

With ThisWorkbook.Worksheets("Sheet1")
    For Each cell In .Range("K1:K1000") 'Column with the list of stocks
        If cell.Value <> "" Then
            cell.Copy
            .Range("S5").PasteSpecial Paste:=xlPasteValues 'Cell S5 contains current stock symbol
        Call GetYahooDataFromJSON 'This macros download historical price data

            Application.ScreenUpdating = False
            Application.EnableEvents = False
            Application.DisplayStatusBar = False
            Application.DisplayAlerts = False

            last = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
            
            Range("A1:G" & last).Sort [A1], xlAscending, Header:=xlYes
            
            DestSh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = ThisWorkbook.Sheets("Sheet1").Range("S5").Value
            Worksheets("Sheet1").Range("F1:F" & last).Copy
            DestSh.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
            Application.CutCopyMode = False
            
        Else
        End If
Next cell
End With

Worksheets("Sheet1").Range("A1:A" & last).Copy
DestSh.Range("B1").PasteSpecial Transpose:=True

DestSh.Activate
DestSh.Columns.AutoFit
DestSh.Range("A1").Activate

    Dim colNo, colStart, colFinish, colStep As Long
    Dim rng2Insert As Range


    colStep = 2
    colStart = Application.Cells(1, 4).Column + 1


    colFinish = (ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column * 2) - colStart


    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual


    For colNo = colStart To colFinish Step colStep
        ActiveSheet.Cells(1, colNo).EntireColumn.Insert

        '***New code inserted
        ActiveSheet.Cells(1, colNo) = "Change%"
        ActiveSheet.Columns(colNo).NumberFormat = "0.00%"
        ActiveSheet.Cells(2, colNo) = "=(RC[-1]-RC[colNo-2])/RC[colNo-2]"
        ActiveSheet.Cells(2, colNo).Columns(colNo).AutoFill
        '***
    Next
   
'***New code inserted
        ActiveSheet.Cells(1, colNo) = "Change%"
        ActiveSheet.Columns(colNo).NumberFormat = "0.00%"
        '***

Dim colFinish2 As Integer, totalRows As Integer

colFinish2 = (ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column)

totalRows = WorksheetFunction.CountA(ActiveSheet.Range("B:B"))

On Error Resume Next

'Application.ScreenUpdating = False

For colNo = 5 To colFinish + 2 Step 2

With ActiveSheet

For rowno = 2 To totalRows

.Cells(rowno, colNo) = (.Cells(rowno, colNo - 1) - .Cells(rowno, 3)) / .Cells(rowno, 3)


Next

End With

Next

Call AverageTotals
    
ThisWorkbook.Sheets("Sheet1").Range("K:L").Clear
ThisWorkbook.Sheets("Sheet1").Range("S11:S12").Clear

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic


'Determine how many seconds code took to run
  SecondsElapsed = Round(Timer - StartTime, 2)

'Notify user in seconds
  MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation



End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,128,120
Messages
5,628,803
Members
416,340
Latest member
PJB1102

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top