VBA copy

[Damo10]

Hi,

I am trying to get the following code to work when i have another sheet active, it works when i am on the Data sheet but not when I have another selected and how can the copy to destination line be changed to only copy the values and not the formulas?

Regards

Sub test()
Dim rng As Range
Dim c As Range
Dim dest As Long
Dim check As String
Dim wsto As Worksheet
Dim wsfrom As Worksheet
Set wsto = Sheets("Data")
Set wsfrom = Sheets("Raw")
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
With wsfrom
Set rng = Range(Range("C5"), Range("C" & Rows.Count).End(xlUp))
dest = 2
For Each c In rng
If c.Offset(, -1).Text = "Completed" Then GoTo Finish
If c.Value = Range("A1").Value Then
c.Resize(, 9).Copy Destination:=wsto.Range("B" & dest)
dest = dest + 1
check = c.Text
End If
Finish:
Next c
End With
If check = "" Then MsgBox ("No data found") & Chr(10) & Chr(10) & "Please check machine number" & Chr(10), vbOKOnly + vbExclamation, ""
With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With
End Sub

 

[tinkythomas]

Hi,

You need to set a reference to the workbook as the sheets collection is a member of the workbook class. To get the values only use pastespecial. I have amended the code (untested)...

Sub test()
Dim rng As Range
Dim c As Range
Dim dest As Long
Dim check As String
Dim wbk As Workbook
Dim wsto As Worksheet
Dim wsfrom As Worksheet
Set wbk = ThisWorkbook
Set wsto = wbk.Sheets("Data")
Set wsfrom = wbk.Sheets("Raw")
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
With wsfrom
Set rng = Range(Range("C5"), Range("C" & Rows.Count).End(xlUp))
dest = 2
For Each c In rng
If c.Offset(, -1).Text = "Completed" Then GoTo Finish
If c.Value = Range("A1").Value Then
c.Resize(, 9).Copy
wsto.Range("B" & dest).PasteSpecial xlPasteValues
Application.CutCopyMode = False
dest = dest + 1
check = c.Text
End If
Finish:
Next c
End With
If check = "" Then MsgBox ("No data found") & Chr(10) & Chr(10) & "Please check machine number" & Chr(10), vbOKOnly + vbExclamation, ""
With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With
End Sub

Hope that helps.

 

[Damo10]

Hi,

I have tried your code and the copying values part works fine but it is still not taking the data from the RAW sheet if another sheet is selected, it is still taking the values from the active sheet.

Regards

 

[tinkythomas]

Sorry missed the unqualified references to the range object. I have amended the code...

Sub test()
Dim rng As Range
Dim c As Range
Dim dest As Long
Dim check As String
Dim wbk As Workbook
Dim wsto As Worksheet
Dim wsfrom As Worksheet
Set wbk = ThisWorkbook
Set wsto = wbk.Sheets("Data")
Set wsfrom = wbk.Sheets("Raw")
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
With wsfrom
Set rng = .Range(.Range("C5"), .Range("C" & .Rows.Count).End(xlUp))
dest = 2
For Each c In rng
If c.Offset(, -1).Text = "Completed" Then GoTo Finish
If c.Value = .Range("A1").Value Then
c.Resize(, 9).Copy
wsto.Range("B" & dest).PasteSpecial xlPasteValues
Application.CutCopyMode = False
dest = dest + 1
check = c.Text
End If
Finish:
Next c
End With
If check = "" Then MsgBox ("No data found") & Chr(10) & Chr(10) & "Please check machine number" & Chr(10), vbOKOnly + vbExclamation, ""
With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With
End Sub

Hope that helps.