Creating two Sheet from One Sheet Based on condition

[jatinjoshi]

I am looking to create two sheet from one excel sheet

Source Excel file (Single Sheet)
https://drive.google.com/file/d/1r3RvRKVXozI4UFeJwvgadzMnG_9Mu7Y4/view?usp=sharing

Target Excel File (Containing Extracted data in two sheet)
https://drive.google.com/file/d/1GMn9mlLwqBoqUzcy43Icr9NAaA7YmUi5/view?usp=sharing

I have done it manually. But Need macro to do the same.

Thanks in advance

 

[Fluff]

How about

Sub SplitData()
   Dim Rng As Range
   Dim Sht As String
   
   For Each Rng In Range("D:D").SpecialCells(xlConstants).Areas
      Sht = IIf(Rng.Resize(1, 1).Value Like "Invoice*", "Bill", "Item")
      If Not Evaluate("isref(" & Sht & "!A1)") Then
          Sheets.Add(, Sheets(1)).Name = Sht
          Rng.EntireRow.Copy Sheets(Sht).Range("A1")
      Else
         Rng.Offset(1).Resize(Rng.Count - 1).EntireRow.Copy Sheets(Sht).Range("A" & Rows.Count).End(xlUp).Offset(1)
      End If
   Next Rng
End Sub

 

[jatinjoshi]

It worked like charm. How ever one more thing is required I want to copy value from

From

Sheet Bill

Inovicerefno Column C
Invoicedate Column D
Sale No Column E

To
Sheet Item
Last Column

Both Sheet has common field contractID Column B

 

[Fluff]

Ok,
Will the ContractID numbers on "Bill" always be unique?
Do you want the copied cells to line up with the 1st instance of the contractId on "Item"?

 

[jatinjoshi]

It will always be unique in Bill and I want to copy values having same contract Id in cells

 

[Fluff]

How about

Sub SplitData()
   Dim Rng As Range
   Dim Sht As String
   
   For Each Rng In Range("D:D").SpecialCells(xlConstants).Areas
      Sht = IIf(Rng.Resize(1, 1).Value Like "Invoice*", "Bill", "Item")
      If Not Evaluate("isref(" & Sht & "!A1)") Then
          Sheets.Add(, Sheets(1)).Name = Sht
          Rng.EntireRow.Copy Sheets(Sht).Range("A1")
      Else
         Rng.Offset(1).Resize(Rng.Count - 1).EntireRow.Copy Sheets(Sht).Range("A" & Rows.Count).End(xlUp).Offset(1)
      End If
   Next Rng
   With CreateObject("scripting.dictionary")
      For Each Rng In Sheets("Bill").Range("B2", Sheets("Bill").Range("B" & Rows.Count).End(xlUp))
         If Not .exists(Rng.Value) Then .Add Rng.Value, Rng.Offset(, 1).Resize(, 3)
      Next Rng
      For Each Rng In Sheets("Item").Range("B2", Sheets("Item").Range("B" & Rows.Count).End(xlUp))
         If .exists(Rng.Value) Then Rng.Offset(, 47).Resize(, 3).Value = .Item(Rng.Value).Value
      Next Rng
   End With
End Sub

 

[jatinjoshi]

Thanks a ton. You nailed it...

Really appreciate your talent...

I will need a little bit more help on this once I gained clarity..

 

[Fluff]

Glad to help & thanks for the feedback

 

[jatinjoshi]

Need a little bit modification to the macro.

In Item Sheet It picks value of from Bill of Column C,D,E. Instead I want to pick Value

From
Sheet Bill
Column D
Column E
Column G
Column BG
Column BH
Column BI

into
Sheet Item

Having Common Field B
------------------------------------------------------------------------------------------------------------------------------------
also attaching another workbook from which I want to fecth following value having common field LOTNO in both file

https://drive.google.com/file/d/1PysV94hiw_b2uoIYgmTsMAIEun7-IwxO/view?usp=sharing

From Dealbook
Column D
Column E
Column K
Column M
Column P

Into Sheet Item (Last columns)

 

[Fluff]

This will do the 1st part

Sub SplitData()
   Dim Rng As Range
   Dim sht As String
   
   For Each Rng In Range("D:D").SpecialCells(xlConstants).Areas
      sht = IIf(Rng.Resize(1, 1).Value Like "Invoice*", "Bill", "Item")
      If Not Evaluate("isref(" & sht & "!A1)") Then
          Sheets.Add(, Sheets(1)).Name = sht
          Rng.EntireRow.Copy Sheets(sht).Range("A1")
      Else
         Rng.Offset(1).Resize(Rng.Count - 1).EntireRow.Copy Sheets(sht).Range("A" & Rows.Count).End(xlUp).Offset(1)
      End If
   Next Rng
   With CreateObject("scripting.dictionary")
      For Each Rng In Sheets("Bill").Range("B2", Sheets("Bill").Range("B" & Rows.Count).End(xlUp))
         If Not .exists(Rng.Value) Then
            .Add Rng.Value, Intersect(Rng.EntireRow, Sheets("Bill").Range("D:E,G:G,BG:BI"))
         End If
      Next Rng
      For Each Rng In Sheets("Item").Range("B2", Sheets("Item").Range("B" & Rows.Count).End(xlUp))
         If .exists(Rng.Value) Then .Item(Rng.Value).Copy Rng.Offset(, 47)
      Next Rng
   End With
End Sub

Your new workbook is coming up as corrupt, so cannot do part 2 and as i'ts a completely new question then you'll need to start a new thread