hassan.ajam
New Member
- Joined
- Oct 25, 2012
- Messages
- 2
I am trying to copy a range of valid cells "non-blank" from "sheet_a" ,"sheet_b" ,"sheet_c" to "sheet3"
i got some help and i was successful to copy from one sheet only. how to copy from all the sheets listed from the same workbook.
following is the VBA code i am using
Sub CopySample()
Dim shSrc As Worksheet
Dim shDst As Worksheet
Dim rSrc As Range
Dim rDst As Range
Dim numCol As Long ' number of columns to copy
On Error GoTo EH
numCol = 12
' select source and dest sheets
Set shSrc = ActiveWorkbook.Worksheets("SheetA")
Set shDst = ActiveWorkbook.Worksheets("Sheet3")
' Select initial rows
Set rSrc = shSrc.Cells(1, 1)
Set rDst = shDst.Cells(1, 1)
' loop over source
Do While rSrc <> "STOP"
' Test Source row, Qty = 0 and Name is not blank
With rSrc
If .Offset(0, 11) > 0 And .Value <> "" Then
'Copy
.Resize(1, numCol).Copy rDst.Resize(1, numCol)
Set rDst = rDst.Offset(1, 0)
End If
End With
Set rSrc = rSrc.Offset(1, 0)
Loop
Exit Sub
EH:
MsgBox "Error " & Err.Description
End Sub
Thanks
Ajam
i got some help and i was successful to copy from one sheet only. how to copy from all the sheets listed from the same workbook.
following is the VBA code i am using
Sub CopySample()
Dim shSrc As Worksheet
Dim shDst As Worksheet
Dim rSrc As Range
Dim rDst As Range
Dim numCol As Long ' number of columns to copy
On Error GoTo EH
numCol = 12
' select source and dest sheets
Set shSrc = ActiveWorkbook.Worksheets("SheetA")
Set shDst = ActiveWorkbook.Worksheets("Sheet3")
' Select initial rows
Set rSrc = shSrc.Cells(1, 1)
Set rDst = shDst.Cells(1, 1)
' loop over source
Do While rSrc <> "STOP"
' Test Source row, Qty = 0 and Name is not blank
With rSrc
If .Offset(0, 11) > 0 And .Value <> "" Then
'Copy
.Resize(1, numCol).Copy rDst.Resize(1, numCol)
Set rDst = rDst.Offset(1, 0)
End If
End With
Set rSrc = rSrc.Offset(1, 0)
Loop
Exit Sub
EH:
MsgBox "Error " & Err.Description
End Sub
Thanks
Ajam
