excel vba | create new list from template with cer

2019-08-29 11:44发布

Hiyall!

I am new to excel macros and vba however willing to learn. Recently I came up with an idea to make specific macro decribed in the topic. Let me explain:

INPUT:

1 list with template style and fill of columns (numbers and formulas) 2 list for lookup function 3 output list

PROCESS: -start loop -for i to end_column on list2 create new list with name =Ai from list2 copy columns from list1 after copying cells with formulas replace every x with =Bi from list2 -save list csv

Yet I have found only saving as .csv, though it casuses error in path, like "impossible path"

Sub SplitSheets2()
    Dim s As Worksheet
    Dim wb as Workbook
    Set wb = ActiveWorkbook
    For Each s In wb.Worksheets
        s.Copy
        ActiveWorkbook.SaveAs wb.Path & "\" & s.Name & ".xlsx", FileFormat:=24
End Sub

where can I find other pieces? And how to make path work?

============= 14h edit I came up with the following code, but it has errors and more questions in comments

Dim c As Range
For Each c In Sheets("reference").Range("A2:A4")
    Sheets.Add After:=ActiveSheet
    Sheets("List2").Name = "123" '123 to change onto =ref!R3A2b but have "out of range error"
    Sheets("temp").Select
    Range("A1:D3").Select
    Selection.Copy
    Sheets("123").Select 'how do I select =ref!R3C2 list againg w/o looking up its name on ref list?
    ActiveSheet.Paste
    Range("C2").Select
    Application.CutCopyMode = False 'dont know yet what does that mean, yet I was only changing formula
    ActiveCell.FormulaR1C1 = "=reference!R3C2+1"
    Selection.AutoFill Destination:=Range("C2:C3"), Type:=xlFillDefault 'idk also how Type:= appeared
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=reference!R3C3*2"
    Selection.AutoFill Destination:=Range("D2:D3")
    Range("D2:D3").Select
End Sub

标签: excel vba
2条回答
2楼-- · 2019-08-29 12:20

Record a macro while you do all of the steps you need to repeat (copying, pasting, entering formulas, saving, etc) and then it will be simple to modify the VBA generated for the macro, to add a loop.

Some tips & examples:

And then the loop could be added with a couple lines:

Dim c as Range
For Each c in Sheets("Sheet1").Range("A1:A10")

    ...(code to repeat here)
    ...(refer to list item as:  c.Value  )

Next c

Edit:

This code loops through all worksheets in the active workbook, and "exports" each one as a separate `.CSV' file, each named after worksheet it came from. A working .xlsm example can be downloaded from JumpShare here. (*Online viewer won't work with VBA.)

Sub MakeWorkbooksFromSheets()
'save each sheet to a new workbook (named after the sheet)

    Dim sht As Worksheet, this_WB As Workbook, new_WB As Workbook
    Dim savePath As String, saveFile As String
    Dim currentWB As String, copyCount As Integer
    Set this_WB = ActiveWorkbook 'create current-workbook object

    If this_WB.Path <> "" Then
        savePath = this_WB.Path  'output path will be same as current file's path...
    Else
        savePath = Application.DefaultFilePath '...unless current file isn't saved yet
    End If

    For Each sht In this_WB.Worksheets
        saveFile = sht.Name & ".csv"

        If Dir(savePath & "\" & saveFile) <> "" Then
            'skip this sheet (or you could change this to delete existing file instead)
            MsgBox "Skipping Sheet - File Already Exists: " & vbCrLf & savePath & "\" & saveFile
        Else
            sht.Copy 'create new workbook, activate it, and copy sht to it
            Set new_WB = ActiveWorkbook 'create output worksheet object

            new_WB.SaveAs Filename:=savePath & "\" & saveFile, FileFormat:=xlCSVUTF8 ' save new file as CSV, or instead you could...

            copyCount = copyCount + 1

            new_WB.Close savechanges:=True 'close new workbook (remove this line to keep it open)
            Set new_WB = Nothing 'free memory of new_workbook object
        End If

    Next
    Set this_WB = Nothing 'discard current-workbook object
    MsgBox copyCount & " sheets copied to new CSV's in folder:" & vbCrLf & savePath
End Sub

Related reading:

查看更多
劫难
3楼-- · 2019-08-29 12:27

I ended up with following code and it works! Thank you all! But I have a question about loop;

Sub MarcoTemplate()
Dim c As Range
Dim n As String
For Each c In Sheets("ref").Range("A2:A3")
    n = c
    Vl = Application.WorksheetFunction.VLookup(n, Sheets("ref").Range("A2:D3"), 2, False)
    Worksheets.Add.Name = c
    ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
    Worksheets("temp").Range("A1:D3").Copy ActiveSheet.Range("A1")
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=ref!R2C2" + "+1"
    Selection.AutoFill Destination:=Range("C2:C3")
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=ref!R2C2" + "*4"
    Selection.AutoFill Destination:=Range("D2:D3")
    Range("G2").Select
    ActiveCell.FormulaR1C1 = Vl
Next c
End Sub

How do I make transition between formula cells? Example:

ActiveCell.FormulaR1C1 = "=ref!R2C2" + "+1"

Here I want to change ref!R2C2 to ref!R2C(c-row number) or something else like c+=1 adding 1 row or 1 column for each new c

@ashleedawg @YowE3K

查看更多
登录 后发表回答