Помогите, пожалуйста, решить следующую задачу:
Есть один файл со списком счетов в одном столбце и суммами по этим счетам в соседнем столбце.
Нужно, при выборе счета нажатием на кнопку формировался файл, содержащий название счета и в этот файл попадали данные по активному счету- номер, сумма. Файлы формируются:

If Selection.Cells(1, 1) = "" Then
MsgBox "Выберите номер счета"
GoTo AEND
Else
End If

If SC <> 1 Then
MsgBox "Выберите номер счета из первого столбца"
GoTo AEND
Else
End If

InvNo = Right(Selection.Cells(1, 1), 1)

FileCopy "D:\счет.xlsx", ("D" + ":" + "\" + Right(Selection.Cells(1, 1), 1) + "." + "xlsx")

Application.Workbooks.Open("D" + ":" + "\" + Right(Selection.Cells(1, 1), 1) + "." + "xlsx").Activate

ActiveWorkbook.Worksheets("Счет").Cells(1, 2).ClearContents

Как записать данные в новый файл?????

Hugo121, спасибо большое.

Hugo121, еще раз большое спасибо.

Djon Player,
спасибо, буду знать

Hugo121, я этого не знала, поэтому сделала вот так:
сначала в новом файле (образец для копирования) использовала ВПР(vlookup) в ячейке, например, (1,3), а потом в код добавила
tgwb.Worksheets("Счет").Cells(1, 3).Value = tgwb.Worksheets("Счет").Cells(1, 3).Value

Hugo121, сама не ожидала, но это работает, как при копировании в excel (специальная вставка, значения).

Hugo121, задачка немного поменялась, номер счета в первом файле находится теперь во втором столбце. Пытаюсь использовать
Selection.Offset(0, 1).Copy tgwb.Worksheets("Счет").Cells(11, 6).Value
или
Cells(x, y).Offset(0, 1).Copy tgwb.Worksheets("Счет").Cells(11, 6).Value

к сожалению, не работает.

Hugo121,
спасибо большое.

Hugo121, помогите, пожалуйста:

Во втором файле, если значение в ячейке 22,6 = 0 , то нужно скрывать строку 22, в противном случае отображать эту строку с данными. Записала макросы.
Все вместе выглядит вот так:


Sub hide1() ' hide1
Rows("22:22").Select
Selection.EntireRow.Hidden = True
Application.Run "Счет.XLS!hide1"
Range("A20:A21").Select
End Sub

Sub Unhide1() ' Unhide1
Rows("21:23").Select
Range("E22").Activate
Selection.EntireRow.Hidden = False
End Sub

If tgwb.Worksheets("Счет").Cells(22, 6) = 0 Then hide1 else Unhide1

Как правильно написать цикл, чтобы работало???
Сейчас высвечивается ошибка 400.

Hugo121, попробовала if, select (с 0, "", trim). Строка не исчезает. Наверное, не туда подставляю.
Посмотрите, пожалуйста:

Sub 1 ()
Dim InvNo As String
Dim RowCounter As Double
Dim SC As Integer
Dim AEND As Label
'Fun hide1

SC = Selection.Column
If Selection.Cells(1, 1) = "" Then
MsgBox "Выберите номер счета"
GoTo AEND
Else
End If

If SC <> 1 Then
MsgBox "Выберите номер из первого столбца "
GoTo AEND
Else
End If

Set wb = ThisWorkbook

InvNo = Right(Selection.Cells(1, 1), 10)

FileCopy "D:\счет.xlsx", ("D:\" + "w_" + Right(Selection.Cells(1, 1), 10) + "счет" + "." + "xls")

Application.Workbooks.Open("D:\" + "w_" + Right(Selection.Cells(1, 1), 10) + "счет" + "." + "xls").Activate

Set tgwb = ActiveWorkbook

tgwb.Worksheets("Счет").Cells(1, 10).Value = InvNo
tgwb.Worksheets("Счет").Cells(22, 6).Value = tgwb.Worksheets("Счет").Cells(22, 6).Value ' данные попадают в ячейку по функции ВПР, а потом, как я писала, х=х значение


Select Case Trim(tgwb.Worksheets("Счет").Cells(22, 6).Value) '
Case 0: Rows(22).EntireRow.Hidden = True
Case Else: Rows(22).EntireRow.Hidden = False
End Select

'If Trim(tgwb.Worksheets("Счет").Cells(22, 6).Value) = 0 Then
'Rows(22).EntireRow.Hidden = True
'Else
'Rows(22).EntireRow.Hidden = False
'End If

tgwb.Worksheets("Счет").Cells(11, 3).Value = tgwb.Worksheets("Счет").Cells(11, 3).Value '

tgwb.Worksheets("Счет").Cells(11, 6).Value = tgwb.Worksheets("Счет").Cells(11, 6).Value '

tgwb.Worksheets("Счет").Cells(17, 7).Value = tgwb.Worksheets("Счет").Cells(17, 7).Value '

tgwb.Worksheets("Счет").Cells(20, 6).Value = tgwb.Worksheets("Счет").Cells(20, 6).Value '

tgwb.Worksheets("Счет").Cells(23, 6).Value = tgwb.Worksheets("Счет").Cells(23, 6).Value '

tgwb.Worksheets("Счет").Cells(25, 6).Value = tgwb.Worksheets("Счет").Cells(25, 6).Value '

tgwb.Worksheets("Счет").Cells(23, 1).Value = tgwb.Worksheets("Счет").Cells(23, 1).Value '

tgwb.Worksheets("Счет").Cells(25, 1).Value = tgwb.Worksheets("Счет").Cells(25, 1).Value '

tgwb.Worksheets("Счет").Cells(26, 1).Value = tgwb.Worksheets("Счет").Cells(26, 1).Value '

MsgBox "Счет создан"

AEND:
End Sub

Спасибо большое.

'Set wb = ThisWorkbook - помогло.

Hugo121, спасибо, сейчас попробую.

Есть еще вопрос:
Есть пользовательская функция Numtranslate (перевод цифр в слова). Есть много старых файлов, в которых эта функция работает и соответственно видна в списке функций Excel.
Сейчас эта функция работает в новом файле только в том случае, если держать открытым старый файл (с работающей функцией) и менять связь.

На всякий случай: раньше был Excel 2003, сейчас 2007.

Подскажите, пожалуйста, что можно сделать.

Hugo121,
Глупый вопрос: как мне найти код этой функции? Я хотела добавить эту функцию хотя бы в нужный файл, но пока не нашла, что добавлять. Как можно посмотреть, может быть, путь к этой фунции в работающих файлах. Из похожего (название "функция перевода...")- есть файл с расширением .bas.
Что с ним делать - не знаю.

Hugo121,
в блокноте посмотрела - это она.

Если кому-нибудь будет полезно, пожалуйста, - мне очень нравится эта функция.

вот она:

'Функция разработана Власовым Игорем
'для всех желающих без каких бы то ни было претензий со стороны автора.
'Автор разрешает использовать данный продукт в любых целях,
'кроме нанесения вреда другим людям и животным.
'Автор не несет никакой ответственности за правильное
'и неправильное употребление данного "продукта".
'
'


Public Function NumTranslate(Refer As Range, CHR_1 As Boolean, WordFOR_1 As String, WordFOR_2_3_4 As String, WordFOR5 As String, _
Optional WrdFOR_1 As String, Optional WrdFOR_2_3_4 As String, Optional WrdFOR5 As String) As String
Attribute NumTranslate.VB_ProcData.VB_Invoke_Func = " \n14"

Dim Word(3, 9) As String
Dim Wrd(9) As String * 12
Dim stroka, Strich As String
Dim volume, number As Double
Dim L_nu, L_num As Integer
Dim slov, sl_v1, strMsg As String
Dim prov As Boolean


'Заполнение массива
Word(1, 1) = "од": Word(2, 1) = "десять": Word(3, 1) = "сто"
Word(1, 2) = "дв": Word(2, 2) = "двадцать": Word(3, 2) = "двести"
Word(1, 3) = "три": Word(2, 3) = "тридцать": Word(3, 3) = "триста"
Word(1, 4) = "четыре": Word(2, 4) = "сорок": Word(3, 4) = "четыреста"
Word(1, 5) = "пять": Word(2, 5) = "пятьдесят": Word(3, 5) = "пятьсот"
Word(1, 6) = "шесть": Word(2, 6) = "шестьдесят": Word(3, 6) = "шестьсот"
Word(1, 7) = "семь": Word(2, 7) = "семьдесят": Word(3, 7) = "семьсот"
Word(1, 8) = "восемь": Word(2, 8) = "восемьдесят": Word(3, 8) = "восемьсот"
Word(1, 9) = "девять": Word(2, 9) = "девяносто": Word(3, 9) = "девятьсот"

Wrd(1) = "одиннадцать"
Wrd(2) = "двенадцать"
Wrd(3) = "тринадцать"
Wrd(4) = "четырнадцать"
Wrd(5) = "пятнадцать"
Wrd(6) = "шестнадцать"
Wrd(7) = "семнадцать"
Wrd(8) = "восемнадцать"
Wrd(9) = "девятнадцать"

On Error GoTo errorlabel
prov = True
stroca = ""

volume = Refer.Value

If volume > 1000000000 Then
MsgBox "Больше 999999999 перевести не могу", 64, "Внимание"
Exit Function
Else
volume = Abs(volume)
volume = Format(volume, "########0.00")
drob = (Format((volume - Int(volume)), "0.00") * 100)
number = Int(volume)
prov = False

L_nu = Val(Right(Str(number), 2))
L_num = Val(Right(Str(number), 1))

If L_nu > 10 And L_nu < 20 Then
slov = " " + WordFOR5
Else
Select Case L_num
Case 1
slov = "ин " + WordFOR_1
Case 2
slov = "а " + WordFOR_2_3_4
Case 3, 4
slov = " " + WordFOR_2_3_4
Case Else
slov = " " + WordFOR5
End Select
End If
L_nu = Val(Right(Str(drob), 2))
L_num = Val(Right(Str(drob), 1))

If L_nu > 10 And L_nu < 20 Then
sl_v1 = WrdFOR5
Else
Select Case L_num
Case "1"
sl_v1 = WrdFOR_1
Case "2", "3", "4"
sl_v1 = WrdFOR_2_3_4
Case Else
sl_v1 = WrdFOR5
End Select
End If
End If
'*******************
Chislo = Str(number)
GoSub Work3:

Chislo = Str(Int(number / 1000))
If Chislo >= 1 Then

L_nu = Val(Right(Str(Chislo), 2))
L_num = Val(Right(Str(Chislo), 1))
If L_nu > 10 And L_nu < 20 Then
Strich = " тысяч"
Else
Select Case L_num
Case "1"
Strich = "на тысяча"
Case "2"
Strich = "е тысячи"
Case "3", "4"
Strich = " тысячи"
Case Else
Strich = " тысяч"
End Select
End If

stroca = Strich + stroca
GoSub Work3:
End If
'------------------------------

Chislo = Str(Int(number / 1000000))
If Chislo >= 1 Then
L_nu = Val(Right(Str(Chislo), 2))
L_num = Val(Right(Str(Chislo), 1))

If L_nu > 10 And L_nu < 20 Then
Strich = " миллионов"
Else
Select Case L_num
Case "1"
Strich = "ин миллион"
Case "2"
Strich = "а миллиона"
Case "3", "4"
Strich = " миллиона"
Case Else
Strich = " миллионов"
End Select
End If

stroca = Strich + stroca
GoSub Work3:
End If


stroca = stroca + slov + " " + IIf(drob < 9, "0" + Trim(Str(drob)), Str(drob)) + " " + sl_v1
If CHR_1 Then
Dim kl_s As String
Dim dl_s As Integer
dl_s = Len(Trim(stroca))
kl_s = Mid(Trim(stroca), 1, 1)
stroca = UCase(kl_s) + Mid(Trim(stroca), 2, dl_s)
Else
End If
NumTranslate = stroca
Exit Function
Work3: ' подрограмма обработки троек чисел
'*****************
For i = 1 To 3
L_nu = Val(Right(Chislo, 2))
L_num = Val(Left(Right(Chislo, i), 1))
If L_nu > 10 And L_nu < 20 And i = 1 Then
stroca = " " + Wrd(L_num) + stroca
i = 2
GoTo jump:
Else
stroca = " " + Word(i, L_num) + stroca

End If
jump:
Next i: Return
'******************

errorlabel:
If prov Then
strMsg = "В данную ячейку необходимо записать число" & Chr(13)
strMsg = strMsg & " Например 1234,23 , исправте запись и запустите" & Chr(13)
strMsg = strMsg & " сначала"
MsgBox strMsg, 64, " Ошибка"
Else
strMsg = "Возникла ошибка: " & Err.Description & Chr(13)
strMsg = strMsg & " номер: " & Err.number
MsgBox strMsg, 64, " Ошибка"

End If
End Function

Hugo121, добавила файл с функцией в ...Microsoft\Excel\XLSTART\ и получила интересный результат - при запуске Excel на первую страницу Excel попадает текст этой функции.

В итоге - записала в основной файл, а в файле который получается (Счет) использую фунцию с ссылкой на исходный файл. Пока работает.

Огромное спасибо.

Я делала тоже самое, только поместила функцию не в PERSONAL.XLS , а в исходный файл.
Спасибо, попробую записать в PERSONAL.XLS