Copy "A1 Current Region" of WS named "Data" and paste to every worksheet that cell A1 is blank.

[VBAProIWish]

Hello All,

I hope the title was clear enough but here are the logical steps I have in mind to accomplish this...

1. Go to the "Data" WS
2. Select cell "A1"
3. CTRL+A to select the Current Region
4. Copy the Current Region
5. Go to the next worksheet

6. If cell A1 is blank
Paste the data (Current Region from the "Data" WS)

If cell A1 is not blank
Do nothing

7. Repeat 5 and 6 until all worksheets are checked.


Please note that both the number and name of worksheets are dynamic and can change so I can't refer to any worksheets by name.


Thanks much!

 

[VBAProIWish]

I tried that code both above and below these 2 lines and got the error

"Run-Time Error 1004"
"Select method of Range class failed"

ws.Range("A1").PasteSpecial xlPasteColumnWidths
ws.Range("A1").PasteSpecial xlPasteAll

I will be checking this last part in the morning tomorrow. Thank you so much for all your help!

 

[MARK858]

Try...

ws.Activate
ws.Rows("1:1").Select
ActiveWindow.FreezePanes = True
ActiveWindow.Zoom = 80

 

[VBAProIWish]

Mark, that one line (ws.activate) is what did the trick for freezing the panes and zooming to 80%.
Thank you for that!

Thank you BigBeachBananas as well for all the help!

 

[MARK858]

You're welcome

 

[VBAProIWish]

For anyone interested, here is the final code.
Thanks to both BigBeachBananas and Mark858 for helping in creating this solution!

Dim wb As Workbook
Dim sourceRng As Range
Dim sourceSheet As Worksheet
Dim ws As Worksheet

Set wb = activeworkbook

'Set wb = ThisWorkbook
Set sourceRng = wb.Sheets("Data").Range("A1").CurrentRegion

    For Each ws In wb.Sheets
        If (ws.Name <> "Data") And (ws.Range("A1") = "") Then
   sourceRng.Copy
  
  
ws.Activate
ws.Rows("2:2").Select
ActiveWindow.FreezePanes = True
ActiveWindow.Zoom = 80

  
ws.Range("A1").PasteSpecial xlPasteColumnWidths
ws.Range("A1").PasteSpecial xlPasteAll

Range("A1").Select
Range("A2").Select



Application.CutCopyMode = False
               
        End If
    Next ws