Я написал макрос, который я хочу повторять по ячейкам, пока ячейка не пуста - PullRequest
0 голосов
/ 14 октября 2019

Макрос начинается в ячейке F6.

Я хочу запустить код, а затем, когда он будет завершен, макрос снова запустит процесс, на этот раз из ячейки F7 ...... и затем повторите процесс с F8 и т. д., пока не будет пустой ячейки.

Надеюсь, это имеет смысл.

Макрос по сути открывает набор данных из сводки, корректирует форматирование и сохраняет еговплоть до рабочего стола в качестве имени файла.

Мне нужно, чтобы этот процесс х раз, в зависимости от количества файлов в списке, который начинается с F6.

    Range("F6").Select
    Selection.ShowDetail = True
    Columns("A:O").Select
    Columns("A:O").EntireColumn.AutoFit
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Range("A1").CurrentRegion.Select
    Sheets("Sheet1").Select
    Sheets("Sheet1").name = "MAP"

    Range("C2").Select
    Application.CutCopyMode = False
    ActiveCell.Copy

    Range("Q1").Select
    ActiveCell.PasteSpecial xlPasteValues


    Windows("Costs 2019.xlsm").Activate
    Sheets("Sheet1").Select
    ActiveWindow.SelectedSheets.Delete
    Range("H6").Select
    Application.CutCopyMode = False
    ActiveCell.Copy

    ActiveCell.FormulaR1C1 = " Electricity Invoicing August 2019"
    Windows("Book1").Activate

    Range("Q2").Select
    ActiveCell.PasteSpecial xlPasteValues

    Application.CutCopyMode = False
    Range("Q4").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-3]C,"""",R[-2]C)"

Dim FName           As String
Dim FPath           As String

    FPath = "C:\Users\" & Environ$("Username") & "\Desktop\"
    FName = Sheets("MAP").Range("Q4").Text
    Sheets("MAP").SaveAs Filename:=FPath & FName
    ActiveWindow.Close
    Range("A1").Select
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...