VBA script help for copying same data into different tabs

mlance617

New Member
Joined
Dec 4, 2024
Messages
8
Office Version
  1. 365
Hi there

I am looking for help on writing some VBA code for the following. I have an entire data tab (titled "paste 1804") I need copied into 2 different tabs with same format, content, etc..:


I have Macro push button labeled "Run data Macro", on a tab labeled "Marcos"

Source tab to copy: "paste 1804"

paste into tab: "locked 1804"

paste into tab: "edit 1804"

box that pops up stating "1804 data copied complete"
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
VBA Code:
Option Explicit

Sub CopySheet()
Dim wb As Workbook, sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet

Set wb = ThisWorkbook
Set sht1 = wb.Sheets("paste 1804")
Set sht2 = wb.Sheets("locked 1804")
Set sht3 = wb.Sheets("edit 1804")

sht1.UsedRange.Copy
sht2.Cells(1, 1).PasteSpecial
sht3.Cells(1, 1).PasteSpecial

Application.CutCopyMode = False

End Sub
 
Upvote 0
Is there anyway to keep the same column width and row spacing based on the "paste 1804" tab. Like an exact carbon copy? But other than that it worked!
 
Upvote 0
VBA Code:
Option Explicit


Sub CopySheet()
Dim wb As Workbook, sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet

Set wb = ThisWorkbook
Set sht1 = wb.Sheets("paste 1804")
Set sht2 = wb.Sheets("locked 1804")
Set sht3 = wb.Sheets("edit 1804")

sht1.UsedRange.Copy
With sht2.Range("A1")
    .PasteSpecial xlPasteAll
    .PasteSpecial xlPasteColumnWidths
End With
With sht3.Range("A1")
    .PasteSpecial xlPasteAll
    .PasteSpecial xlPasteColumnWidths
End With

Application.CutCopyMode = False

End Sub
 
Upvote 0
Am I missing something or is a copy of the sheet OK?
If you copy all the data and formatting of a sheet and paste it in A1, you just end up with a copy of the sheet.

Code:
Sub Copy_Sheet_Twice()
Dim shtArr, i As Long
shtArr = Array("locked 1804", "edit 1804")
    For i = LBound(shtArr) To UBound(shtArr)
        ThisWorkbook.Sheets("paste 1804").Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = shtArr(i)
    Next i
MsgBox "Sheet ""paste 1804"" successfully copied twice!"
End Sub
 
Upvote 0
I have Macro push button labeled "Run data Macro", on a tab labeled "Marcos"

Source tab to copy: "paste 1804"

paste into tab: "locked 1804"

paste into tab: "edit 1804"

box that pops up stating "1804 data copied complete"
Try
Code:
Sub test()
    Dim e
    For Each e In Array("locked 1804", "edit 1804")
        If Not Evaluate("isref('" & e & "'!a1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = e
        Sheets("paste 1804").Cells.Copy Sheets(e).[a1]
    Next
    Application.CutCopyMode = False
    MsgBox "1804 data copied complete"
End Sub
 
Upvote 0
VBA Code:
Option Explicit


Sub CopySheet()
Dim wb As Workbook, sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet

Set wb = ThisWorkbook
Set sht1 = wb.Sheets("paste 1804")
Set sht2 = wb.Sheets("locked 1804")
Set sht3 = wb.Sheets("edit 1804")

sht1.UsedRange.Copy
With sht2.Range("A1")
    .PasteSpecial xlPasteAll
    .PasteSpecial xlPasteColumnWidths
End With
With sht3.Range("A1")
    .PasteSpecial xlPasteAll
    .PasteSpecial xlPasteColumnWidths
End With

Application.CutCopyMode = False

End Sub


amazing. Last step, need to make two separate excel files saved to the Desktop, from a push button macro. Exact carbon copy row/column & height width.

-Is it possible to add current date and time in the naming? ".....12924_0849am"

1st file is the "locked 1804" tab. Can be named "original_locked_1804_(todays date & time)

2nd file is the "edit 1804" tab. Can be named "New_edited_1804_(todays date & time)
 
Upvote 0
Am I missing something or is a copy of the sheet OK?
If you copy all the data and formatting of a sheet and paste it in A1, you just end up with a copy of the sheet.

Code:
Sub Copy_Sheet_Twice()
Dim shtArr, i As Long
shtArr = Array("locked 1804", "edit 1804")
    For i = LBound(shtArr) To UBound(shtArr)
        ThisWorkbook.Sheets("paste 1804").Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = shtArr(i)
    Next i
MsgBox "Sheet ""paste 1804"" successfully copied twice!"
End Sub


Thanks can you help me with the following? I need to make two separate excel files saved to the Desktop, from a push button macro. With exact carbon copy row/column & height width.

-And is it possible to add current date and time in the naming? ".....12924_0849am"

1st file is the "locked 1804" tab. Can be named "original_locked_1804_(todays date & time)

2nd file is the "edit 1804" tab. Can be named "New_edited_1804_(todays date & time)
 
Upvote 0
So you want to save each sheet ("locked 1804" and "edit 1804") as an individual new workbook on the desktop?

BTW, don't quote if not absolutely necessary, which it seldom is.

Is it still one sheet ("paste 1804") saved with different names or two different sheets each saved as an individual workbook?
 
Last edited:
Upvote 0
Code:
Sub Save_Twice_To_Desktop()
Dim newNm, a As String, dt As String, tm As String, i As Long
a = CreateObject("WScript.Shell").specialfolders("Desktop")
newNm = Array("locked 1804", "edit 1804")    '<---- Change names as required
dt = Format(CStr(Now), "ddmmmyy_hhmm")
Application.ScreenUpdating = False
    For i = LBound(newNm) To UBound(newNm)
        Sheets("paste 1804").Copy
        With ActiveWorkbook
            .SaveAs a & "\" & newNm(i) & " " & dt & ".xlsx"
            .Close
        End With
    Next i
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,224,522
Messages
6,179,297
Members
452,903
Latest member
Knuddeluff

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
Back
Top