Here is a simple loop that is copying a range to another location on the same worksheet. This also needs to loop through all the remaining worksheets and perform the same copy paste values. My use of variable "Dim ws" in the loop is suspect.
Sub UpdateSPCData()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Select Case UCase(wsLoop)
Case "Data - MOAQ", "Report" 'Do nothing
Case Else
Range("H2:H5").Copy
Range("I2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Select
Next ws
End Sub
I think you need this. Also, if checking upper case names you must make sure you are comparing with upper case text.
Sub UpdateSPCData()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Select Case UCase(ws.Name)
Case "DATA - MOAQ", "REPORT" 'Do nothing
Case Else
ws.Range("H2:H5").Copy
ws.Range("I2").PasteSpecial Paste:=xlPasteValues
End Select
Next ws
End Sub
Related
I get workbooks with multiple tabs of identically formatted data but the exact ranges of the data varies between workbooks. Instead of modifying the code each time, I am trying to establish a user input that would define a reference range on one worksheet that can be applied to all the worksheets. My problem is that the defined range keeps referring back to my "reference" range and not applying to the active worksheet. I am ending up with the same data being copied repeatedly.
Sub Copy_data()
Dim Destination_Rng As Range
Dim Header_Rng As Range
Dim Data_Rng As Range
Dim Label_Rng As Range
Dim ws As Worksheet
Dim SheetName As String
Dim SheetExists As Boolean
On Error Resume Next
SheetName = InputBox("Please enter a name for your new sheet")
SheetExists = False
With ThisWorkbook
'Check if the Sheet exists
For Each ws In .Worksheets
If ws.Name = SheetName Then
SheetExists = True
MsgBox ("Summary tab already exists - Ending Script")
Exit Sub
End If
Next
If SheetExists = False Then
'If the sheet dont exists, create
.Worksheets.Add Sheets(1)
ActiveSheet.Name = SheetName
End If
End With
Sheets(2).Activate
'Get user input for data header
Set Header_Rng = Application.InputBox("Select by mouse or enter (e.g. A1:B2) the Header Data:", Type:=8)
'Get user input for data to be compiled
Set Data_Rng = Application.InputBox("Select by mouse or enter (e.g. A1:B2) the Data to be compiled:", Type:=8)
'Get user input for data label
Set Label_Rng = Application.InputBox("Select by mouse or enter (e.g. A1:B2) the data label:", Type:=8)
On Error GoTo 0
'Test to ensure User Did not cancel
If Header_Rng Is Nothing Then Exit Sub
If Data_Rng Is Nothing Then Exit Sub
If Label_Rng Is Nothing Then Exit Sub
Header_Rng.Copy
Sheets(SheetName).Activate
Range("B1").PasteSpecial
'sometimes the header is formatted weird so adding a value between header and data
Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.Value = "X"
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> SheetName Then
Data_Rng.Copy
Sheets(SheetName).Activate
Set Destination_Rng = Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Destination_Rng.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Label_Rng.Cells(1, 1).Copy
Sheets(SheetName).Activate
Destination_Rng.Offset(0, -1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next ws
End Sub
I made this simple code, or at least tried. But I have one small problem.
When I type For I = 14 To 25 I don't really know what I'm doing. I have a sheet called "Master" and in the range K6:V6 I have every name of every sheet I want to go through. I would like to write something like this: For I = sheets("Master").range("K6:V6") But this does not work, anyone that can help to me to assign the "names" in this array to I?
The rest of the code works as it should, it could be optimized by not having "select" but I don't seem to be able to do it so I took the easy way out. Thank you for your help!
Dim I As Integer
For I = 14 To 25
If Sheets(I).Visible = False Then
'If sheet = Not visble
'-----------------------------------------------------------------------------------------------------
Sheets(I).Visible = True
AA = Sheets("Master").Range("K6").Value
Sheets(AA).Select
ActiveSheet.Unprotect
ActiveSheet.Range("C3:C120").Copy
Range("G3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("C6:C120").ClearContents
ActiveSheet.Range("L6:M117").ClearContents
ActiveSheet.Protect
Range("A1").Select
Sheets(I).Visible = False
'-----------------------------------------------------------------------------------------------------
Else:
'If sheet = visble
'-----------------------------------------------------------------------------------------------------
AA = Sheets("Master").Range("K6").Value
Sheets(AA).Select
ActiveSheet.Unprotect
ActiveSheet.Range("C3:C120").Copy
Range("G3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("C6:C120").ClearContents
ActiveSheet.Range("L6:M117").ClearContents
ActiveSheet.Protect
Range("A1").Select
'-----------------------------------------------------------------------------------------------------
End If
Next I
Each Worksheet in a file is held in the Worksheets collection. You can look at each worksheet in the collection in turn and act on it.
Sub Test()
Dim wrkSht As Worksheet
Dim shtMaster As Worksheet
Dim InList As Range
Dim VisibleSetting As Long
Set shtMaster = ThisWorkbook.Worksheets("Master") 'Reference to Master worksheet
'This will look at each worksheet in the worksheets collection and reference it with 'wrkSht'
For Each wrkSht In ThisWorkbook.Worksheets
'Look for the worksheet name in the K6:V6 range.
Set InList = shtMaster.Range("K6:V6").Find(wrkSht.Name, LookIn:=xlValues, LookAt:=xlWhole)
'If the name is found InList will not be nothing.
If Not InList Is Nothing Then
With wrkSht
VisibleSetting = .Visible 'Remember the visible setting.
.Visible = xlSheetVisible
.Unprotect
.Range("C3:C120").Copy
.Range("G3").PasteSpecial xlPasteValues
Union(.Range("C3:C120"), .Range("L6:M17")).ClearContents
.Visible = VisibleSetting 'Put the visible setting back.
.Protect
End With
End If
Next wrkSht
End Sub
Further reading:
ThisWorkbook
With...End With Statement
For Each...Next Statement
I put together code to copy data pulled by formulas and then paste it as values within the same sheet. I have multiple workbooks that vary in the amount of worksheets/tabs they contain.
Problem #1:
My first worksheet on every file is called REGION.
The code is not executing on the "REGION" worksheet as designed and is also skipping the worksheet immediately after it.
Problem #2
Depending on the workbook, after 6 worksheets, I get
Run-Time Error '1004'
Problem #3
On workbooks small enough for the code to cycle through all worksheets and not finding any more worksheets to apply the code I get
Error 400
In summary, I need to:
1. Figure out why the code is skipping the worksheet immediately after the one called REGION (1st Tab)
2. Prevent error '1004' because the program is performing the same function over and over on multiple worksheets (read that I should probably set it to save every few tabs to prevent this but not sure how to do it while looping).
3. Add to the code a line that stops the cycle without throwing an error message.
Sub COPYPASTE()
Dim ws As Worksheet
For Each ws In Sheets
If ws.Name <> "REGION" Or ws.Name <> "Legend" Then
Range("C3:I47").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A2").Select
End If
ActiveSheet.Next.Select
Next
End Sub
Avoid using Select and/or Activate (and related: ActiveSheet, etc.) and while we're at it, rather than Copy/PasteSpecial, just do a direct value-assignment using the range's Value property.
So that this:
Dim ws As Worksheet
For Each ws In Sheets
If ws.Name <> "REGION" Or ws.Name <> "Legend" Then
Range("C3:I47").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A2").Select
End If
ActiveSheet.Next.Select
Next
Becomes this (also note the Or should be an And, I think)
Dim ws As Worksheet
Dim rng as Range
For Each ws In Sheets
'Do not operate on either of Region or Legend worksheets
If ws.Name <> "REGION" And ws.Name <> "Legend" Then
Set rng = ws.Range("C3:I47")
rng.Value = rng.Value2
End If
Next
Sub CPRow()
Range("D14:K14").Select
Selection.Copy
Range("D15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
i want to add code to do the following:
1- if the sheet name begins with a number then copy the range (D14:K14) and paste it in Range (D15:K15) as Values.
2- Go to next sheet and do the same, and stop when there is a sheet with no number or until sheet name starts with a letter.
Any help is appreciated.
The code below will copy Range("D14:K14") form Worksheets("Sheet1") (modify "Sheet1" to your sheet's name), and paste it to all worksheet's that their Name start with a number.
Option Explicit
Sub CPRow()
Dim Sht As Worksheet
Dim ShttoCopy As Worksheet
Set ShttoCopy = Worksheets("Sheet1") ' <-- modify "Sheet1" to the sheet you want to copy Range("D14:K14") from
For Each Sht In ThisWorkbook.Worksheets
If IsNumeric(Left(Sht.Name, 1)) Then
ShttoCopy.Range("D14:K14").Copy
Sht.Range("D15").PasteSpecial xlPasteValues
End If
Next Sht
End Sub
I have a range of data that is in the same position in every worksheet in a book and will always be in that position. When the macro is run the data should be copied and added to a report sheet. I have that part working but I need to use a paste special:
.PasteSpecial xlPasteValues
as there are formulas in the range. I am unsure where to add the paste special condition in this code, since I'm using .Copy, Destination.
Option Explicit
Sub CreateTempPSDReport()
Dim WS As Worksheet, Rept As Worksheet
Set Rept = Sheets("Temporary PSD Report")
Application.ScreenUpdating = False
'--> Loop through each worksheet except the report and
'--> Copy the set range to the report
For Each WS In ThisWorkbook.Worksheets
If Not WS.Name = "Temporary PSD Report" Then
WS.Range("A42", "I42").Rows.Copy _
Destination:=Rept.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next
Application.ScreenUpdating = True
End Sub
I need to use a paste special:
WS.Range("A42", "I42").Rows.Copy _
Destination:=Rept.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
In such a case you do not use the above method. You use this
WS.Range("A42", "I42").Rows.Copy
Rept.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False