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

[dilshod_k]

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

 

[Zot]

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]

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]

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]

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.

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

 

[dilshod_k]

The thread has been cross published at

Transfer data between two workbooks. - OzGrid Free Excel/VBA Help Forum

[xpost][/xpost] Hello everyone, I have Sub TestTable in the file BacktestFile.xlsm that processes data of the single (active) sheet at a time and copies results to the added new sheet with the (same name) + T. The aim is to make it automatically loop…

www.ozgrid.com