Copy Data to multiple Worksheet Based on cell values

Negi1984

Board Regular
Joined
May 6, 2011
Messages
198
Hi All,

I have an workbook. and below sheets contains :-

1) RAMSES : this is main sheet from where I need to copy only column F and paste in multiple sheets. based on cell value mentioned in column C.

2) CTA : data needs to paste in this sheet if any cell value of column C in Ramses is mentioned as "CTA"

3) IDF : data needs to paste in this sheet if any cell value of column C in Ramses is mentioned as "IDF"

4) MED : data needs to paste in this sheet if any cell value of column C in Ramses is mentioned as "MED"

5) NOE : data needs to paste in this sheet if any cell value of column C in Ramses is mentioned as "NOE"

6) SWT : data needs to paste in this sheet if any cell value of column C in Ramses is mentioned as "SWT"

7) WST : data needs to paste in this sheet if any cell value of column C in Ramses is mentioned as "WST"

8) BLANK : data needs to paste in this sheet if any cell value of column C in Ramses is mentioned as "#N/A" or any Blank Cell in column C in Ramses.

I have attached the sample file as well in below link.
https://1drv.ms/x/s!Ap80Ku6M2Tw5gTbGRwA5Q6nGCIGO

Thanks in advance for your valuable support.

Regards,
Rajender
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
It seems there is no header in tabs !!
 
Upvote 0
How about
Code:
Sub CopyFltr()
   Dim Ary As Variant
   Dim i As Long
   
   Ary = Array("CTA", "IDF", "MED", "NOE", "SWT", "WST", "#N/A")
   
   With Sheets("Ramses")
      If .AutoFilterMode Then .AutoFilterMode = False
      For i = 0 To UBound(Ary) - 1
         .Range("A1:F1").AutoFilter 3, Ary(i)
         .AutoFilter.Range.Columns(6).Copy Sheets(Ary(i)).Range("A1")
      Next i
      .Range("A1:F1").AutoFilter 3, Ary(i), xlOr, ""
      .AutoFilter.Range.Columns(6).Copy Sheets("Blank").Range("A1")
   End With
End Sub
 
Upvote 0
See next code
To be launched from sheet RAMSES
Code:
Option Explicit
Sub Treat()
Dim WS  As Worksheet
Const FR   As Integer = 2
Const WSCol As String = "C"
Const WkCol As String = "F"
Const WgCode1 As String = "#N/A"
Const WgCode2 As String = ""
Const WsBlkName As String = "Blank"
Dim I  As Integer, LR  As Integer
Dim WsName As String


     LR = Cells(Rows.Count, "A").End(3).Row
     For I = FR To LR
        If (IsError(Cells(I, WSCol))) Then
            WsName = ""
        Else
            WsName = Cells(I, WSCol).Value
        End If
        If ((WsName <> WgCode1) And (WsName <> WgCode2)) Then
            If (IsSheetExists(WsName)) Then _
                Cells(I, WkCol).Copy Destination:=Sheets(WsName).Cells(Rows.Count, 1).End(3)(2)
        Else
            Cells(I, WkCol).Copy Destination:=Sheets(WsBlkName).Cells(Rows.Count, 1).End(3)(2)
        End If
     Next I
     MsgBox (" Job Done")
End Sub


Function IsSheetExists(ByVal SheetName As String) As Boolean
    On Error Resume Next
    IsSheetExists = Len(Sheets(SheetName).Name)
    On Error GoTo 0
End Function
 
Last edited:
Upvote 0
Hi Fluff,

Code is working but output is not 100% correct. 1 point to note is there are no headers in RAMSES sheet. (I will create headers in it if needed).
Also if in cell C in RAMSES sheet there is not data for any sheet then its showing #REF error in respective output sheet.

Note : All cell values in column F contains formula.

Regards,
Rajender
 
Upvote 0
Hi PCL,

When I am running the code, its showing me compile error.
Sub or function not defined.

Please suggest.

Regards,
Rajender
 
Upvote 0
"Sub or function not defined." did you copy the full code included the Function one at the bottom ???
For which statement is shown such message ??
 
Last edited:
Upvote 0
Hi PCL,

I just noticed. I missed to copy that function code.
I tested and tried. but its giving me #Ref error in respective sheets. My column F contains formula.


What I will do Create another macro to copy paste column F2 to last row as value in RAMSES sheet , and run your code than.
Also please suggest, if I need to show my output from column A1 than what adjustment I needed in given code(suppose in RAMSES sheet my data started from row 2)?

Regards,
Rajender
 
Upvote 0
Another run
Code:
Option Explicit
Sub Treat()
Dim WS  As Worksheet
Const FR   As Integer = 2
Const WSCol As String = "C"
Const WkCol As String = "F"
Const WgCode1 As String = ""
Const WsBlkName As String = "Blank"
Dim i  As Integer, LR  As Integer
Dim WsName As String


     LR = Cells(Rows.Count, "A").End(3).Row
     For i = FR To LR
        If (IsError(Cells(i, WSCol))) Then
            WsName = ""
        Else
            WsName = Cells(i, WSCol).Value
        End If
        If (WsName <> WgCode1) Then
            If (IsSheetExists(WsName)) Then _
                Sheets(WsName).Cells(Rows.Count, 1).End(3)(2) = Cells(i, WkCol).Value
        Else
            Sheets(WsBlkName).Cells(Rows.Count, 1).End(3)(2) = Cells(i, WkCol).Value
        End If
     Next i
     MsgBox (" Job Done")
End Sub


Function IsSheetExists(ByVal SheetName As String) As Boolean
    On Error Resume Next: IsSheetExists = Len(Sheets(SheetName).Name): On Error GoTo 0
End Function
 
Last edited:
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,733
Members
448,294
Latest member
jmjmjmjmjmjm

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top