E
elf27
Another situation where I'm cutting and pasting between different worksheets.
The problem is that for some reason, the data copied FROM the source sheet
(sheet1) becomes values only on the paste sheet (sh) AND the source sheet.
Doesn't make any sense to me. I've checked all my other procedures and
narrowed it down to this one.
Any ideas?
--------------------------------------------
Public Sub SyncAESheet()
Dim ArtCol As Long
Dim i As Long
Dim FirstRow As Variant
Dim LastRow As Variant
Dim CellVal As Long
Dim RowNum As Long
Dim ArtNum As Long
Dim LookUpRng As Range
Dim sh As Worksheet
Application.ScreenUpdating = False
Set sh = ActiveSheet
ArtCol = 1 'means col A
With sh ' This loop finds the first and last rows
i = 1
Do Until FirstRow <> Empty
If IsNumeric(.Cells(i, "A")) Then
If .Cells(i, "A").Value > 0 Then
FirstRow = i
End If
ElseIf i > 50 Then FirstRow = 1
Else: FirstRow = Empty
End If
i = i + 1
Loop
i = FirstRow
Do Until LastRow <> Empty
If .Cells(i + 1, "A").Value = "" Then
LastRow = i
ElseIf .Cells(i + 2, "A").Value = "" Then
LastRow = i + 1
Else: LastRow = Empty
i = i + 1
End If
Loop
End With
With sh 'This loop does the replacing
Set LookUpRng = Sheet1.Range("A1:V306")
RowNum = 1
For i = FirstRow To LastRow
ArtNum = sh.Cells(i, ArtCol)
.Cells(ArtNum) = IsText
RowNum = Application.Match(ArtNum, Sheet1.Range("A:A"), 0)
If IsError(RowNum) Then
CellVal = "Error"
End If
Sheet1.Rows(RowNum).Copy
sh.Rows(i).PasteSpecial xlValues
Next i
End With
Application.ScreenUpdating = True
End Sub
The problem is that for some reason, the data copied FROM the source sheet
(sheet1) becomes values only on the paste sheet (sh) AND the source sheet.
Doesn't make any sense to me. I've checked all my other procedures and
narrowed it down to this one.
Any ideas?
--------------------------------------------
Public Sub SyncAESheet()
Dim ArtCol As Long
Dim i As Long
Dim FirstRow As Variant
Dim LastRow As Variant
Dim CellVal As Long
Dim RowNum As Long
Dim ArtNum As Long
Dim LookUpRng As Range
Dim sh As Worksheet
Application.ScreenUpdating = False
Set sh = ActiveSheet
ArtCol = 1 'means col A
With sh ' This loop finds the first and last rows
i = 1
Do Until FirstRow <> Empty
If IsNumeric(.Cells(i, "A")) Then
If .Cells(i, "A").Value > 0 Then
FirstRow = i
End If
ElseIf i > 50 Then FirstRow = 1
Else: FirstRow = Empty
End If
i = i + 1
Loop
i = FirstRow
Do Until LastRow <> Empty
If .Cells(i + 1, "A").Value = "" Then
LastRow = i
ElseIf .Cells(i + 2, "A").Value = "" Then
LastRow = i + 1
Else: LastRow = Empty
i = i + 1
End If
Loop
End With
With sh 'This loop does the replacing
Set LookUpRng = Sheet1.Range("A1:V306")
RowNum = 1
For i = FirstRow To LastRow
ArtNum = sh.Cells(i, ArtCol)
.Cells(ArtNum) = IsText
RowNum = Application.Match(ArtNum, Sheet1.Range("A:A"), 0)
If IsError(RowNum) Then
CellVal = "Error"
End If
Sheet1.Rows(RowNum).Copy
sh.Rows(i).PasteSpecial xlValues
Next i
End With
Application.ScreenUpdating = True
End Sub