paindoookhan
asked on
Copy the cells from sheet1 to sheet2
Hi I want to copy from sheet1 to sheet2
If column z doesn't contain "Default" then
Loop from row 2 till end of row in sheet 1
Copy row2,column1 to row2, column8
Paste to row2,column1
Then
Copy row3, column1 to row 3 column 8
Paste to row15, column1
If the column in sheet 1 contains "default" goto the next row
I'm attaching the file with 2 sheets and also the code
1st sheet contains the content and the second sheet shows the result it should happen
If column z doesn't contain "Default" then
Loop from row 2 till end of row in sheet 1
Copy row2,column1 to row2, column8
Paste to row2,column1
Then
Copy row3, column1 to row 3 column 8
Paste to row15, column1
If the column in sheet 1 contains "default" goto the next row
I'm attaching the file with 2 sheets and also the code
1st sheet contains the content and the second sheet shows the result it should happen
Sub Macro1()
Dim sNm As String
Dim ws As String
Dim wsNew As Worksheet
Dim WrkSheetCount As Integer
Dim WorkSheetNameNew(15) As String
Dim LastColumn As Long
Dim LastRow As Long
Dim ws_Count As Integer
Dim PSA_SubCount As Integer
Dim headerColumnCount As Integer
Dim TR As Integer
TR = 2
'Check how many worksheets are there
ws_Count = ActiveWorkbook.Worksheets.Count
WrkSheetCount = CountVisible
'MsgBox "Number of Sheets are " & WrkSheetCount
'Loops through each worksheet
'For SheetCount = WrkSheetCount
' For SheetCount = ws_Count To 1 Step -1
' If Worksheets(SheetCount).Visible = True Then
MsgBox "Worksheet Name " & ActiveWorkbook.Worksheets(1).Name
MsgBox "Worksheet Name " & ActiveWorkbook.Worksheets(2).Name
'Sheets(ActiveWorkbook.Worksheets(2).Name).Range("A " & I & ":H" & I).Select
ActiveWorkbook.Worksheets(1).Activate
With ActiveWorkbook.Worksheets(1).UsedRange
LastColumn = .Columns(.Columns.Count).Column
End With
With ActiveWorkbook.Worksheets(1).UsedRange
LastRow = .Rows(.Rows.Count).Row
End With
MsgBox "LastRow " & LastRow
MsgBox "LastColumn is" & LastColumn
For I = 2 To LastRow 'Row Count
If Cells(I, 26) = "Default" Then
Next I
Else
ActiveSheet.Range("A " & I & ":H" & I).Select
Selection.Copy
Sheets(2).Select.Range("A" & TR).Select
ActiveSheet.Paste
TR = TR + 13
End If
Next I
End Sub
'Last Row:
Sub xlCellTypeLastCell_Example_Row()
Dim LastRow As Long
With ActiveSheet
LastRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
End With
End Sub
Function UsedRange_Example_Row() As Integer
Dim LastRow As Long
With ActiveSheet.UsedRange
LastRow = .Rows(.Rows.Count).Row
End With
End Function
'Last Column:
Sub xlCellTypeLastCell_Example_Column()
Dim LastColumn As Long
With ActiveSheet
LastColumn = .Range("A1").SpecialCells(xlCellTypeLastCell).Column
End With
MsgBox LastColumn
End Sub
Function UsedRange_Example_Column() As Integer
Dim LastColumn As Long
With ActiveSheet.UsedRange
LastColumn = .Columns(.Columns.Count).Column
End With
End Function
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function
Think you missed the attachment?
ASKER
sample file is there
ASKER
I need this urgently please
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.