SaveCopyAs, перебирая горизонтальный список, выбирая каждое второе значение, пока не будет найдена пустая ячейка - PullRequest
Новая
       9

SaveCopyAs, перебирая горизонтальный список, выбирая каждое второе значение, пока не будет найдена пустая ячейка

0 голосов
/ 30 июня 2019

Я пытаюсь написать макрос для SaveCopyAs, просматривая горизонтальный список на «листе 3», выбирая каждое второе значение, начиная с ячейки «B1», пока не будет найдена пустая ячейка. Я также хочу, чтобы «лист 3» был удален, а все другие листы сохранялись в виде текста только в новых копиях.

Пока я написал и протестировал несколько отдельных кусков кода, чтобы сделать это вручную, хотя должно быть более элегантное решение этой проблемы.

Очевидно, я все еще очень плохо знаком с Visual Basic, код, который у меня пока есть:

В исходном листе я запускаю этот код: 

Sheets("Sheet 3").Select
Range("B1").Select
Selection.Copy
Sheets("PSM").Select
Range("A2:F2").Select
ActiveSheet.Paste
Sheets("PSM").Select
ThisFile = Range("A2").Value & ".xlsm"
ActiveWorkbook.SaveCopyAs filename:=ThisFile

Sheets("Sheet 3").Select
Range("D1").Select
Selection.Copy
Sheets("PSM").Select
Range("A2:F2").Select
ActiveSheet.Paste
Sheets("PSM").Select
ThisFile = Range("A2").Value & ".xlsm"
ActiveWorkbook.SaveCopyAs filename:=ThisFile

Этот пример кода - первые 2 шага, всего 30, пока он не закончится в ячейке BH1

Затем я запускаю этот код на каждом последующем сохраненном листе 

Sheets("PSM").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Sheet 1.1").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Sheet 3").Select
Application.CutCopyMode = False
    Application.DisplayAlerts = False
    Sheets("Sheet 3").Delete
    Application.DisplayAlerts = True
Sheets("Sheet 1.1").Select
Sheets("Sheet 1.1").Name = "Non PSM"
Sheets("PSM").Select
Sheets("PSM").Name = "PSM"
Range("A1:B1").Select
Sheets("Non PSM").Select
Range("A1:B1").Select
Sheets("PSM").Select
ThisFile = Range("A2").Value & ".xls"
ActiveWorkbook.SaveCopyAs FileName:=ThisFile

Получается нужный мне результат, отдельная рабочая книга для каждого значения в горизонтальном списке только в тексте, с удаленным «листом 3», однако все еще довольно трудно открывать каждый последующий лист для запуска второго бита код. Как я могу упростить это?

Заранее благодарим вас за опыт.

...