How to separate data into different worksheet and another workbook

[fluffyvampirekitten]

I have this Workbook("Test"), worksheet"Countries"
- I have this column "R" which holds certain values ( America , India , Canada , Japan)

I want to separate the rows depending on the criteria .
Copy the values to another workbook - Workbook2 "FinalTest"
Workbook 2 have the respective tabs( America , India , Canada , Japan) but its empty.

- I want to copy/paste all the "America" rows in "America Worksheet" into Workbook2
- I want to copy/paste all the "India" rows in "India Worksheet" into Workbook2
- I want to copy/paste all the "Canada" rows in "Canada Worksheet" into Workbook2
- I want to copy/paste all the "Japan" rows in "Japan" Worksheet" into Workbook2

Any suggestion on how to do this ?
vba?
Thanks in advance

 

[Takae]

Please try after save your books.

Sub sample_fluffy()
Dim buf As String
Dim ws As Worksheet, wb As Workbook
Const Target As String = "C:\FinalTest.xlsx" 'Please change to full path.
    buf = Dir(Target)
    If buf = "" Then
        MsgBox Target & vbCrLf & "is not exist.", vbExclamation
        Exit Sub
    End If
  
    For Each wb In Workbooks
        If wb.Name = buf Then
            Call sample_fluffy2
            Exit Sub
        End If
    Next wb
    Workbooks.Open Target
    Call sample_fluffy2
End Sub
Sub sample_fluffy2()
Dim i As Long, LastR As Long
Dim str As String
Dim ws As Worksheet
Dim Tgt As Workbook
Set Tgt = Workbooks("FinalTest.xlsx")
    With ThisWorkbook.Sheets("Countries")
        For Each ws In Tgt.Worksheets
            LastR = ws.Cells(Rows.Count, 1).End(xlUp).Row
            .Range("A1").AutoFilter Field:=18, Criteria1:=ws.Name
            .Range(.Range("A2"), .Range("A1").SpecialCells(xlCellTypeLastCell)).Resize(, 18).Copy
            ws.Cells(LastR + 1, 1).PasteSpecial Paste:=xlPasteValues
        Next
    End With
    Msgbox "Done"
End Sub

 

[fluffyvampirekitten]

Omg it can work ! Thanks alot

One last thing ,
Can i delete the "country" column in the FinalTest.xlsx ?
is it possible to change this also ?

Const Target As String = "C:\FinalTest.xlsx" 'Please change to full path.

Because this macro will be use in different computer. Thus , i dont want to keep changing the directory.

How to bypass the FinalTest.xlsx encrypted protected file.

 

[dmt32]

Hi,
you could modify Takae code to display the Open Dialog to allow users to select the file if that is what you want.

Try this modified version & see if helps:

Sub sample_fluffy()
    Dim FileName As Variant
    Dim wb As Workbook
    
        FileName = GetFile()
        If Not FileName = False Then
            Application.ScreenUpdating = False
            Set wb = Workbooks.Open(FileName, ReadOnly:=False)
            sample_fluffy2 wb
        Else
        'cancel pressed
        End If
End Sub


Sub sample_fluffy2(ByVal wb As Object)
    Dim LastR As Long
    Dim ws As Worksheet
    
    With ThisWorkbook.Sheets("Countries")
        For Each ws In wb.Worksheets
            LastR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
            .Range("A1").AutoFilter Field:=18, Criteria1:=ws.Name
            .Range(.Range("A2"), .Range("A1").SpecialCells(xlCellTypeLastCell)).Resize(, 18).Copy
            ws.Cells(LastR + 1, 1).PasteSpecial Paste:=xlPasteValues
        Next
    End With
    
    Application.ScreenUpdating = True
    MsgBox "All Done", 48, "Copying Complete"
End Sub




Function GetFile(Optional Title As String = "Select File To Open") As Variant
    Dim FileFilter As String
    Dim FilterIndx As Integer
    
    FilterIndx = IIf(Val(Application.Version) < 12, 1, 2)


    FileFilter = "Excel 2003 (*.xls),*.xls," & _
              "Excel 2007 > (*.xlsx),*.xlsx," & _
              "All Excel Files (*.xl*),*.xl*," & _
              "All Files (*.*),*.*"


    GetFile = Application.GetOpenFilename(FileFilter, FilterIndx, Title)
End Function

The Function GetFile displays the Open Dialog & returns the selected workbook FileName to Open which is then passed as an object to Takae next code sample_fluffy2.
You can use the Function in other procedures where you need to display Open Dialog.

Hope Helpful

Dave

 

[fluffyvampirekitten]

With ThisWorkbook.Sheets("Countries")

i get errors for this line open dialog , is it for the test or final test file ?