select an entire range of data that has a specific string in its header ("jan", "feb", march, etc...)

[sm12345]

hello, I have a big data set where row 1 has the month typed in as Jan, Feb, March, April... and so on.
I need to select the range of data that has Jan in it's header and copy it to a new sheet, rename the sheet as Jan and save the new sheet as a new workbook..

I tried a if statement and a do while and failed. please suggest some ideas or how to solve this problem.

if you can suggest a code where the data range to be selected based on month and separated into newsheets, it would be really helpful..

 

[Alex Blakenburg]

Can you provide a sample of your data perferably in XL2BB format. It seems unlikely that you only want to copy across 1 column.
Perhaps also post the code you already have.

 

[sm12345]

Can you provide a sample of your data perferably in XL2BB format. It seems unlikely that you only want to copy across 1 column.
Perhaps also post the code you already have.

i tried couple times but the XL2BB disappears

pleases see the images for the data below

THC	jan	jan	jan	jan	feb	feb	feb	march	march	march
	1​	2​	4​	5​	6​	7​	8​	9​	10​	11​
GLU	0.663569​	0.297575​	0.718525​	0.330449​	0.011032​	0.977895​	0.818577​	0.173517​	0.783141​	0.892297​
GLU	0.716058​	0.877671​	0.534152​	0.565504​	0.017116​	0.684788​	0.4901​	0.281332​	0.862112​	0.469749​
HIGH		0.32852​	0.233969​	0.534432​	0.115408​	0.452614​	0.460014​	0.221496​	0.3375​	0.098674​
HIGH	0.526988​	0.522078​	0.26897​	0.377497​	0.787708​	0.247247​	0.865984​	0.215339​	0.753054​	0.926192​
HIGH	0.586559​	0.709367​	0.185411​	0.951425​	0.924164​	0.815717​	0.283352​	0.665908​	0.373785​	0.294595​
HIGH	0.791967​	0.882532​	0.864811​	0.544805​	0.533771​	0.789415​	0.241184​	0.421762​	0.788149​	0.698101​
LOW	0.98713​	0.737204​	0.275094​	0.694793​	0.303823​	0.505524​	0.435742​	0.421296​	0.041507​	0.542166​
LOW	0.450777​	0.003937​	0.60729​	0.35572​	0.274474​	0.465836​	0.984785​	0.262179​	0.857186​	0.307698​
LOW	0.26809​	0.735631​	0.970883​	0.241022​	0.971806​	0.526215​	0.921239​	0.048913​	0.854481​	0.991878​
LOW	0.982536​	0.638502​	0.650161​	0.316867​	0.467594​	0.53497​	0.837631​	0.305074​	0.984845​	0.36223​
MID	0.845824​	0.516984​	0.595139​	0.319288​	0.896728​	0.378583​	0.849236​	0.204008​	0.894597​	0.935285​
MID	0.184758​	0.170659​	0.307671​	0.743905​	0.956708​	0.304133​	0.528031​	0.616306​	0.768207​	0.758728​
MID	0.595354​	0.832392​	0.44355​	0.939465​	0.866734​	0.412041​	0.585998​	0.455595​	0.05974​	0.775075​

 

[Alex Blakenburg]

Give this a try:-

Sub CopyToNewWorkbook()

    Dim thisWB As Workbook
    Dim destWB As Workbook
    Dim thisSht As Worksheet
    Dim destSht As Worksheet
    Dim mthName As String
    Dim colLabel As Long, colmthStart As Long, colmthEnd As Long
    Dim rowLast As Long, rowHdg As Long, colLast As Long
    Dim i As Long
    Dim destFullName As String
    
    Application.ScreenUpdating = False
    Application.Calculation = False
    
    Set thisWB = ThisWorkbook
    Set thisSht = ActiveSheet
    colLabel = 1
    colmthStart = colLabel + 1
    rowHdg = 1
    
    With thisSht
        rowLast = .Cells(.Rows.Count, colLabel).End(xlUp).Row
        colLast = .Cells(rowHdg, .Columns.Count).End(xlToLeft).Column
        mthName = .Cells(rowHdg, colmthStart)
    End With
    
    ' Loop through columns to get start and end of month
    For i = colLabel + 1 To colLast
        With thisSht
            If .Cells(rowHdg, i) <> .Cells(rowHdg, i + 1) Then
                colmthEnd = .Cells(rowHdg, i).Column
                
                Workbooks.Add xlWBATWorksheet
                Set destWB = ActiveWorkbook
                Set destSht = ActiveSheet
                destSht.Name = mthName
                
                ' Copy column 1 - Labels column
                .Range(.Cells(rowHdg, colLabel), .Cells(rowLast, colLabel)).Copy
                destSht.Range("A1").PasteSpecial Paste:=xlPasteAll                          ' <---- Change paste to values and format if required

                ' Copy month
                .Range(.Cells(rowHdg, colmthStart), .Cells(rowLast, colmthEnd)).Copy
                destSht.Range("A1").Offset(0, 1).PasteSpecial Paste:=xlPasteAll             ' <---- Change paste to values and format if required
                destSht.Range("A1").CurrentRegion.Columns.AutoFit
                destSht.Range("A1").Select
                destFullName = thisWB.Path & Application.PathSeparator & Replace(thisWB.Name, ".xlsm", " " & mthName & ".xlsx")
                Application.DisplayAlerts = False
                destWB.SaveAs Filename:=destFullName, FileFormat:=xlOpenXMLWorkbook
                Application.DisplayAlerts = True
                                
                ' Advance to next month
                colmthStart = colmthEnd + 1
                mthName = .Cells(rowHdg, colmthStart)
                
            End If
        End With
    
    Next i
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.Calculation = True

End Sub