Excel VBA, чтобы скопировать список нового лист

У меня есть список в Excel, содержащее сведение о людях Содержит Город, адрес и имяExcel VBA, чтобы скопировать список нового лист

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

Итак, если у меня есть город по имени Дублин, мне нужен макрос, чтобы создать новый лист с именем dublin, зайдите в список, возьмите все города по имени Дублин, скопируйте и вставьте их в рабочий лист в Дублине (также как, конечно, другие столбцы)

Я использую макросы по этой ссылке: http://www.mrexcel.com/forum/excel-questions/727407-visual-basic-applications-split-data-into-multiple-worksheets-based-column.html создатель mirabeau.

Код выглядит следующим образом:

Sub columntosheets() 

Const sname As String = "Sheet1" 'change to whatever starting sheet 
Const s As String = "A" 'change to whatever criterion column 
Dim d As Object, a, cc& 
Dim p&, i&, rws&, cls& 
Set d = CreateObject("scripting.dictionary") 
With Sheets(sname) 
    rws = .Cells.Find("*", , , , xlByRows, xlPrevious).Row 
    cls = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column 
    cc = .Columns(s).Column 
End With 
For Each sh In Worksheets 
    d(sh.Name) = 1 
Next sh 

Application.ScreenUpdating = False 
With Sheets.Add(after:=Sheets(sname)) 
    Sheets(sname).Cells(1).Resize(rws, cls).Copy .Cells(1) 
    .Cells(1).Resize(rws, cls).Sort .Cells(cc), 2, Header:=xlYes 
    a = .Cells(cc).Resize(rws + 1, 1) 
    p = 2 
    For i = 2 To rws + 1 
     If a(i, 1) <> a(p, 1) Then 
      If d(a(p, 1)) <> 1 Then 
       Sheets.Add.Name = a(p, 1) 
       .Cells(1).Resize(, cls).Copy Cells(1) 
       .Cells(p, 1).Resize(i - p, cls).Copy Cells(2, 1) 
      End If 
      p = i 
     End If 
    Next i 
    Application.DisplayAlerts = False 
    .Delete 
    Application.DisplayAlerts = True 
    Application.ScreenUpdating = True 
End With 
Sheets(sname).Activate 

End Sub

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

источник

2015-07-01 Matthew Cremona

Вы пытались дублировать рабочий лист, сортировать по городам, а затем удалять то, что вам не нужно по порядку? Таким образом, вам не нужно беспокоиться о копировании чего-либо. – Lumigraphics

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

Я предполагаю, что вы начали в колонке А, строка 1.

dim strCity as string 
dim strAdd as string 
dim strName as string 
for i = 1 to Sheets("[TableSheet]").Cells(Rows.Count, "A").End(xlUp).row 
    strCity = Sheets("[TableSheet]").range("A" & i) 
    strAdd = Sheets("[TableSheet]").range("B" & i) 
    strName = Sheets("[TableSheet]").range("C" & i) 

    Sheets(strCity).Range("A" & i) = strCity 
    Sheets(strCity).Range("B" & i) = strAdd 
    Sheets(strCity).Range("C" & i) = strName 
next

[tableSheet], конечно, имя листа с вашими information.If вы не udnerstand и есть вопросы, которые я могу с удовольствием ответим ,

источник

2015-07-01 20:24:41

Эй, Дэвид! Спасибо за ваш ответ, я столкнулся с ошибкой во время выполнения, опубликованной ниже, с любыми советами? Извините Если я могу задавать глупые вопросы, но я пытаюсь упростить некоторые очень суровые задачи при работе с моими очень ограниченными знаниями. –

Петля, вероятно, зашла слишком далеко. Вероятно, присваивает пустое значение strName, что приводит к сбою Sheets (strname). Если вы попробуете его с i = 1 To Sheets («[TableSheet]»). Ячейки (Rows.Count, «B»). End (xlUp) .Row - 1, это работает? И работает ли он даже для значений LAST или пропускает их? Если это не я предлагаю добавить в конце кода, чтобы увидеть, где он выпадает. Ура! –

спасибо за ваш быстрый ответ. Я использовал его в простом списке, и он работал нормально. Тем не менее, я применил его к немного более сложному сценарию и редактировать код следующим образом:

Dim strDB As String 
 
Dim strName As String 
 
Dim strDate As String 
 
Dim strHour As String 
 
Dim strMin As String 
 
Dim strGR As String 
 

 
For i = 1 To Sheets("[TableSheet]").Cells(Rows.Count, "B").End(xlUp).Row 
 
    strDB = Sheets("[TableSheet]").Range("A" & i) 
 
    strName = Sheets("[TableSheet]").Range("B" & i) 
 
    strDate = Sheets("[TableSheet]").Range("C" & i) 
 
    strHour = Sheets("[TableSheet]").Range("D" & i) 
 
    strMin = Sheets("[TableSheet]").Range("E" & i) 
 
    strGR = Sheets("[TableSheet]").Range("F" & i) 
 

 
    Sheets(strName).Range("A" & i) = strDB 
 
    Sheets(strName).Range("B" & i) = strName 
 
    Sheets(strName).Range("C" & i) = strDate 
 
    Sheets(strName).Range("D" & i) = strHour 
 
    Sheets(strName).Range("E" & i) = strMin 
 
    Sheets(strName).Range("F" & i) = strGR 
 
Next

Мне нужно сортировать столбец B. Всякий раз, когда я запускаю его я получаю сообщение об ошибке выполнения " 9 'Подзаголовок за пределами допустимого диапазона. Я знаю, что это значит, но я не могу найти, где я ошибся в коде.

источник

2015-07-01 22:01:53

Excel VBA, чтобы скопировать список нового лист

ответ

Смежные вопросы