Macro for Excel - Help Needed

**dominic21** · 01-13-2012, 11:25 PM

Sub testexport()
     '
     ' export Macro
     
    Range("A1:B50").Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs Filename:= _
    "C:\directory\name.csv" _
    , FileFormat:=xlCSV, CreateBackup:=False
    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
     
End Sub

Here's what I have so far. Ideally I want it to do the following things:

-Save the Range("A1:B50"), then Range("A51:B100"), then Range("A101:B150") and so on.

- I want each of them to save as an individual .CSV file, with the file names increasing in integers of 1.

Any Excel Macro wizards out there? I would love some help with this, thanks.

**JieJenn** · 01-13-2012, 11:49 PM

I create a macro based on your criteria. The macro will first look the last row of column A, and decide how many csv files to produce. For instance, if there is 300 items, then the macro will produce 6 files (300/50 = 6)

Look at the sample file and see if that is what you're looking for. You might need to change the directory url.

Here is the code if anyone is interested.

Sub SaveCSV()
Dim LR As Long, i As Long
Dim Increment As Single
'CSV FileFormat = 6
With Application
.DisplayAlerts = False
End With

Increment = 1

LR = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To LR Step 50
        Range(Cells(i, 1), Cells(i + 49, 2)).Copy
        On Error GoTo ErrHandle
        ActiveWorkbook.SaveAs Filename:="C:\Users\Jie\Desktop\Test\CSV" & Increment & ".CSV", FileFormat:=6
        Increment = Increment + 1
    Next i
    
With Application
.DisplayAlerts = True
End With

ErrHandle:
With Application
.DisplayAlerts = True
End With
End Sub

**shg** · 01-13-2012, 11:57 PM

Welcome to the forum.

Please take a few minutes to read the forum rules, and then amend your thread title accordingly.

Thanks.

**dominic21** · 01-14-2012, 12:28 AM

Originally Posted by JieJenn

I create a macro based on your criteria. The macro will first look the last row of column A, and decide how many csv files to produce. For instance, if there is 300 items, then the macro will produce 6 files (300/50 = 6)

Look at the sample file and see if that is what you're looking for. You might need to change the directory url.

Here is the code if anyone is interested.

Sub SaveCSV()
Dim LR As Long, i As Long
Dim Increment As Single
'CSV FileFormat = 6
With Application
.DisplayAlerts = False
End With

Increment = 1

LR = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To LR Step 50
        Range(Cells(i, 1), Cells(i + 49, 2)).Copy
        On Error GoTo ErrHandle
        ActiveWorkbook.SaveAs Filename:="C:\Users\Jie\Desktop\Test\CSV" & Increment & ".CSV", FileFormat:=6
        Increment = Increment + 1
    Next i
    
With Application
.DisplayAlerts = True
End With

ErrHandle:
With Application
.DisplayAlerts = True
End With
End Sub

It works in the sense that it creates 6 csvs, but they all contain the 300 original rows. I need it to take 50 and separate it basically.

**JieJenn** · 01-14-2012, 01:54 AM

It is actually more complicated than I thought. Took me awhile to come up with an inefficient solution. Same file, but try this code.

Option Explicit

Sub SaveCSV()
Dim LR As Long, i As Long, J As Long
Dim Increment As Single, NumCopies As Single
Dim WS As Worksheet, WSData As Worksheet
'CSV FileFormat = 6

With Application
.DisplayAlerts = False
End With

Set WSData = Worksheets("Data")
LR = WSData.Cells(Rows.Count, 1).End(xlUp).Row
Increment = WorksheetFunction.RoundUp(LR / 50, 0)

For J = 1 To Increment
    Call DeleteSheet(J)
    Sheets.Add.Name = "CSV" & J
Next J

J = 1

    For i = 1 To LR Step 50
         Set WS = Worksheets("CSV" & J)
        With WSData
            .Select
            .Range(Cells(i, 1), Cells(i + 49, 2)).Copy WS.Range("A1")
        End With
            J = J + 1
    Next i
Call SaveCSVWB
With Application
.DisplayAlerts = True
End With

ErrHandle:
With Application
.DisplayAlerts = True
End With
End Sub

Private Sub DeleteSheet(ByRef J)
On Error Resume Next
Worksheets("CSV" & J).Delete
End Sub

Private Sub SaveCSVWB()
Application.DisplayAlerts = False
Dim sh As Worksheet
    For Each sh In Worksheets
        If Not (sh.Name = "Data") Then
        sh.Copy
        On Error Resume Next
        ActiveWorkbook.SaveAs "C:\Users\Jie\Desktop\Test\" & sh.Name & ".csv", 6
        ActiveWorkbook.Close
        End If
    Next sh
Application.DisplayAlerts = True
End Sub

**pike** · 01-14-2012, 02:35 AM

Your post does not comply with Rule 7 of our Forum RULES. Please do not ignore Moderators' or Administrators' requests - note that this includes requests by senior members as well, if you are unclear about their request or instruction then send a private message to them asking for help. Do not post a reply to a thread where a moderator has requested an action that has not been complied with e.g Title change or Code tags...etc