Как итеративно копировать каждый столбец на одном листе на разные листы

Question

Я пытаюсь использовать VBA для достижения следующей цели:

У меня есть два листа: «выручка» и «налог с продаж», и они фиксируют налог с доходов и продаж 100 магазинов с 1 по 28 мая. Сейчас я пытаюсь создать лист для каждого магазина, в котором записывается налог с доходов и продаж с 1 по 28 мая.

Sub test1()


    Sheets("Sheet1").Select
    Sheets("Sheet1").Copy Before:=Sheets(17)

    Sheets("revenue").Select
    Range("D154:D168").Select
    Selection.Copy

    Sheets("Sheet1 (2)").Select
    Range("C5").Select
    ActiveSheet.Paste

    Sheets("sales tax").Select
    Range("D138:D152").Select
    Application.CutCopyMode = False
    Selection.Copy

    Sheets("Sheet1 (2)").Select
    Range("F5").Select
    ActiveSheet.Paste

    Sheets("Sheet1 (2)").Select
    Sheets("Sheet1 (2)").Name = " reportF "

End Sub

Используя этот код, я могу установить файл только для 1 магазина каждый раз. Какой синтаксис цикла я должен использовать, чтобы пройти через все магазины?

Answer 1

Похоже, у ваших данных есть название магазина в столбце D? Этот код выполняет все ячейки в столбце D и копирует их на отдельные листы в зависимости от содержимого

    Sub ExampleCode
    Dim r as range  'declare a pointer variable
    Dim ws as worksheet  'declare a worksheet variable
    set r = Range("d1")  'point to fist cell
    Do   'Start a loop
       If SheetNotExist(r.text) then  'if no sheet of that name
          set ws = worksheets.add(after:=worksheets.count)  'add one
          ws.name = r.text        'and name it as text in r
       End if
       r.copy worksheets(r.text).cells(rows.count,4).end(xlup).offset(1,0)  'copy to next blank cell
       set r = r.offset(1,0) 'shift pointer down one cell
    Loop until r.text = ""  'keep going until r is empty
    End Sub


   Function SheetNotExist(s as string) as boolean  'check if sheet exists
   On error goto nope  'jump on error
   Dim ws as worksheet
   set ws = worksheets(s)  'this will error if sheet doesn't exist
  'so if we get here the sheet does exist
   SheetNotExist = False 'so return false
   Exit Function 'and go back
   nope:  'we only get here if sheet doesn't exist
   SheetNotExist = True 'so return that
   End Function

Написано на моем телефоне - не иметь Excel, поэтому возможны опечатки - поэтому код может не скомпилироваться,