VBA code to conditionally copy the data [Solved/Closed]
sunny2u8614
Posts Thursday February 2, 2012Registration date
June 4, 2012
Last seen
-
May 24, 2012 at 02:07 AM - Latest reply: sunny2u8614
Posts Thursday February 2, 2012Registration date
June 4, 2012
Last seen
- Jun 4, 2012 at 11:34 AM
need help!
see I need a vba code that can copy data from sheet1(raw data) to sheet 2,sheet3 and so on is certain condition matches..example RAW data is on sheet1,
need a macro that can automatically put data in sheet2 if place=AB that is complete raw,put data i.e complete raw in sheet3 if place=CD and so on ..and that is along with the Title.
he data it contain is different then I asked but the logic is same.I need all the data in sheet1 will be copied to the sheet2,sheet3 and so on according to the "Group" in sheet1..
the sheet attached is without macro.
Good one Sunny,
I meant for you to change the sheet names.
But since I had some spare time (and I am a kind person) I did it for you.
Here is the code:
Sub MoveData()
Dim lRow As Integer
lRow = Range("A" & Rows.Count).End(xlUp).Row
Sheets("raw").Activate
For Each cell In Range("F2:F" & lRow)
cell.EntireRow.Copy
Sheets(cell.Value).Activate
Range("B" & Rows.Count).End(xlUp).Offset(1, -1).PasteSpecial
Next cell
Application.CutCopyMode = False
End Sub
Great work again from you man!
I really appreciate your work,but one question,since this raw data is changeable and new group is added as required so can you tell me how can it change it according to the requirement..
The adjusted code will check if a sheet already exists with the groups name. If not, a sheets is created with the missing groups name along with the format (first row header and column width of the first 6 columns.).
Here is the code:
Sub MoveData()
Dim lRow As Integer
lRow = Range("A" & Rows.Count).End(xlUp).Row
Sheets("raw").Activate
For Each cell In Range("F2:F" & lRow)
If Not SheetExists(cell.Value) Then
Sheets.Add
ActiveSheet.Name = cell.Value
Sheets("raw").Range("A1:F1").Copy
Sheets(cell.Value).Range("A1").PasteSpecial Paste:=xlPasteAll
Sheets(cell.Value).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
End If
cell.EntireRow.Copy
Sheets(cell.Value).Activate
Range("B" & Rows.Count).End(xlUp).Offset(1, -1).PasteSpecial
Next cell
Application.CutCopyMode = False
End Sub
Function SheetExists(SheetName As String) As Boolean
SheetExists = False
On Error GoTo NoSuchSheet
If Len(Sheets(SheetName).Name) > 0 Then
SheetExists = True
Exit Function
End If
NoSuchSheet:
End Function
has helped 1704 users this month
but this is showing error called "invalid and unqualified" and also please let me know where we can set the condition?