How should i write this loop?

[myespooir]

Hi there,

I would like to write the following loop, could you give me some idea how to write it?

I need the macro to copy columns with the same region in the mater workbook to another workbook.

For example, the macro will copy the column A to C to a new workbook named EAST.
then the macro will come back to the master workbook and copy column A and column D to G to a new workbook named SOUTH... until all the region row =""

Column A	B	C	D	E	F	G	H	I	J
Name
Region	EAST	EAST	SOUTH	SOUTH	SOUTH	SOUTH	NORTH	NORTH	WEST
...
...

<tbody>
</tbody>

I am thinking about calculating columns and using x and y to loop through it, but not sure how to do it. Could you help me with this?

Range(Cells(1, x), Cells(800, y)).Copy

Thanks a million!!

Christina

 

[Zach Prins]

Hi Christina,

Assuming the Region names are in the first row, you can use the following code:

Sub copyColumns()


    Dim iCol As Integer 'counter for the column number
    Dim curReg As String 'current Region
    Dim Sht As Worksheet 'the main worksheet
    Dim iDest As Integer 'the column number to append to in new sheet
    
    Set Sht = ActiveSheet
    
    'Start at column B, loop until Region is empty
    iCol = 2
    While Not Sht.Cells(1, iCol) = ""
    
        curReg = Sht.Cells(1, iCol)
    
        'if the worksheet doesnt exist, create and copy column A with current Region
        If Not WorksheetExists(curReg) Then
        
            Sheets.Add
            ActiveSheet.Name = curReg
            Sht.Range("A:A").Copy Destination:=ActiveSheet.Range("A:A")
            Sht.Cells(1, iCol).EntireColumn.Copy Destination:=ActiveSheet.Range("B:B")
        
        'else, copy current Region to the existing sheet
        Else
        
            iDest = Worksheets(curReg).UsedRange.Columns.Count + 1
            Sht.Cells(1, iCol).EntireColumn.Copy Destination:=ActiveSheet.Cells(1, iDest)
        
        End If
    
        iCol = iCol + 1
    
    Wend


End Sub


Function WorksheetExists(ByVal WorksheetName As String) As Boolean


    Dim Sht As Worksheet
    
    For Each Sht In ThisWorkbook.Worksheets
        If Application.Proper(Sht.Name) = Application.Proper(WorksheetName) Then
            WorksheetExists = True
            Exit Function
        End If
    Next Sht
    
    WorksheetExists = False
    
End Function

Regards,
Zach

 

[myespooir]

Hi Zach,

Thank you so much for your quick reply! There are some column changes (see table below) and new info. Could you please help with the following changes?

- Column A to Column AE are basic product info.
- Column AF to ... are the purchase quantity by store.
- Region is on the 9th row.

Regardless the region, Column A to AE need to be copied to the new sheet. From Column AF on, the macro needs to copy the columns with the same region over to the new workbook.

Column A	B	AE	AF	AG	AH	AI	AJ	AK
		Store Name	1	2	3	4	5	6
		Region	EAST	EAST	EAST	SOUTH	NORTH	NORTH
Products	Price	Min. Quan
001 002	70 60	5 8	10 16	25 60	...

<tbody>
</tbody>

There are 2 more sheets (named Summary and Final Format) in the master workbook be to copied over to the new workbook along with the first region sheet. Can the Macro copy these 2 sheets as well?

Once the new workbook is created, can the Macro also save it as well (on desktop), and name the workbook with the region?

Thanks a million!!
Christina