Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Копирование данных с одного листа на другой
 
Уважаемые форумчане!

Помогите макросом, задача которого при нажатии на кнопку SAVE заключается в копирование данных с листа "Info" столбец "B" и вставить данные на лист "AMLTable" начиная со строки А2. При повторном нажатии на кнопку, данные на листе "AMLTable" не перезаписывались, а дополнялись.

Заранее благодарю.
 
как-то так
Код
Sub cmdSave()
    Dim r As Integer, rmax As Long
    Dim ShF As Worksheet, ShT As Worksheet
    
    Set ShF = ThisWorkbook.Sheets("Info")
    Set ShT = ThisWorkbook.Sheets("AMLTable")
    
    rmax = ShT.Cells(ShT.Rows.Count, 1).End(xlUp).Row + 1
    For r = 5 To 21
        If r < 15 Then ShT.Cells(rmax, r - 4) = ShF.Cells(r, 2)
        If r > 15 Then ShT.Cells(rmax, r - 5) = ShF.Cells(r, 2)
    Next r
End Sub
 
webley,спасибо!
 
Здравствуйте,

У меня еще одна просьба, можно ли слегка подкорректирвоать код, чтоб там стояла проверка на повтор, то есть после нажатия кнопки "SAVE" он сверяет Type code со страницы "Info" cо с Type code на странице "AMLTable" и если кода совпали, то перезаписывает строчку, если нет, создает новую

Заранее благодарю за помощь
Изменено: oggis - 30 Июл 2017 11:52:16
 
Код
Sub test()
Dim sht1 As Worksheet, sht2 As Worksheet
Dim rowcnt&, arr(), msg$, cell As Range
Set sht1 = Sheets("Info")
Set sht2 = Sheets("AMLTable")
rowcnt = sht2.Cells(sht2.Rows.Count, 1).End(xlUp).Row + 1
With sht1
    msg = .Cells(6, 2).Value
    arr = .Range("b5:b21").Value
End With
sht2.Columns(2).NumberFormat = "@"
Set cell = sht2.Columns(2).Find(msg)
If Not cell Is Nothing Then
    Range("a" & cell.Row).Resize(, UBound(arr)) = Application.Transpose(arr)
Else
     Range("a" & rowcnt).Resize(, UBound(arr)) = Application.Transpose(arr)
End If
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
Код
Sub cmdSave()
    Dim r As Integer, rmax As Long
    Dim ShF As Worksheet, ShT As Worksheet
     
    Set ShF = ThisWorkbook.Sheets("Info")
    Set ShT = ThisWorkbook.Sheets("AMLTable")
    
    On Error Resume Next
        rmax = Application.WorksheetFunction.Match(ShF.Cells(6, 2), ShT.Columns(2), 0)
    On Error GoTo 0
    If rmax = 0 Then rmax = ShT.Cells(ShT.Rows.Count, 1).End(xlUp).Row + 1
    
    For r = 5 To 21
        If r < 15 Then ShT.Cells(rmax, r - 4) = ShF.Cells(r, 2)
        If r > 15 Then ShT.Cells(rmax, r - 5) = ShF.Cells(r, 2)
    Next r
End Sub
 
Nordheim, webley, спасибо!
 
Уважаемые форумчане!

Вот уже почти год пользуемся вашим решением, спасибо вам еще раз за помощь. Но спустя время форма шаблона немного изменилась и теперь информация на обоих листах в горизонтальном формате (не получается загрузить файл, все зависает на 90%, размер файла 15кб). Можно подкорректировать код, чтоб он копировал данные строчки, а не столбца? Остальные условия те же:

Цитата
oggis написал:
чтоб там стояла проверка на повтор, то есть после нажатия кнопки "SAVE" он сверяет Type code со страницы "Info" cо с Type code на странице "AMLTable" и если кода совпали, то перезаписывает строчку, если нет, создает новую

Спасибо большое за помощь!
Изменено: oggis - 17 Апр 2018 10:11:13
 
15К должны вообще без проблем загрузиться. Попробуйте ещё раз.
 
Получилось загрузить файл пример из дома
 
Напишите что нужно сделать поконкретней. По файлу вижу на одном листе таблица на другом заголовки, что нужно куда переносить?
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, При нажатие кнопки SAVE нужно копировать строки со страницы "Info" на страницу "AML Table", при копировании сверять Type Code со страницы "Info" со Type Code на странице "AML Table", и если кода совпали, то перезаписывать строчку, если нет, то создать новую.
 
Скрытый текст
Изменено: Nordheim - 18 Апр 2018 09:12:57
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, спасибо Вам, что откликнулись! Во время работы макроса, заметил, что при первом запуске он обрабатывает только первые три строки, но при повторном уже обрабатывает все нормально. Не знаете в чем может быть проблема?
Изменено: oggis - 18 Апр 2018 22:11:45
 
Замените строку
Код
If Not IsEmpty(larr(1, 1)) Then .Range("a" & i).Resize(i, UBound(larr, 2)).Value = larr

на
Код
If Not IsEmpty(larr(1, 1)) Then .Range("a" & i).Resize(x, UBound(larr, 2)).Value = larr
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, спасибо большое!
Страницы: 1
Читают тему (гостей: 1)