не копирует с одной книги в другую / Microsoft Office

ReSQL.ru

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Новые сообщения | Избранное

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / не копирует с одной книги в другую

4 сообщений из 4, страница 1 из 1

не копирует с одной книги в другую

#37244220

aser123

Гость

не хочет копировать.
есть папочка, в которой, к примеру, ячейки з одной книги, нужно скопировать в другую книгу.

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.

Sub test()
Dim MyPath As String
    Dim iFileName As String
    Dim i As Long
    Dim sSheet As String
    MyPath = "C:\as\"
    iFileName = Dir(MyPath)
    i =  1 
    On Error Resume Next
    Do While iFileName <> ""
     Workbooks.Open (MyPath + iFileName)
    Windows(iFileName).Activate
    Worksheets("1").Range("А1").Copy  'Копирует ячейку 
    Workbooks("test1.xlsm").Sheets( 1 ).Cells( 1 ,  1 ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False 'Специальная вставка в ячейку
    Application.CutCopyMode = False
    workbooks(ifilename).Close
    iFileName = Dir
    Loop
End Sub

...

Рейтинг:

0 / 0

03.05.2011, 17:44

| Ответить | Цитировать | Написать

не копирует с одной книги в другую

#37244247

aser123

Гость

вот так работает

Workbooks(iFileName).Sheets("1").Range("A1").Copy Destination:=Workbooks("test2").Worksheets("1").Range("A1")

странно что вот так :

Workbooks(iFileName).Sheets("1").Range("A1").Copy Workbooks("test2").Worksheets("1").Range("A1") или так

Workbooks("test2").Worksheets("1").Range("A1") = Workbooks(iFileName).Sheets("1").Range("A1") не работает....

...

Рейтинг:

0 / 0

03.05.2011, 18:02

| Ответить | Цитировать | Написать

не копирует с одной книги в другую

#37244794

NullUzer

Гость

Из кода видно, что все данные копируются в одну и ту же ячейку в книге "test1.xlsm" - A1, то есть сдвиг не происходит.
Попробуй так:

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.

Sub ConsolidateDataAser123()

    Dim fso As New FileSystemObject
    Dim aFile As File
    Dim wkb As Workbook, wks As Worksheet, sh As Worksheet
    Dim iRow As Long
    
    iRow =  1 
    Set sh = ActiveSheet
    
    For Each aFile In fso.GetFolder("C:\as\").Files
    
        If fso.GetExtensionName(aFile.Name) Like "xls*" Then
        
            Set wkb = Workbooks.Open(aFile.Path)
            Set wks = wkb.Worksheets("1")
            wks.Range("A1").Copy
            sh.Cells(iRow,  1 ).PasteSpecial xlPasteValues
            
            iRow = iRow +  1 
            
            wkb.Close SaveChanges:=False
            Set wks = Nothing
            Set wkb = Nothing
    
        End If
            
    Next

End Sub

...

Рейтинг:

0 / 0

04.05.2011, 10:00

| Ответить | Цитировать | Написать

не копирует с одной книги в другую

#37248398

aser123

Гость

Sub test()
Dim MyPath As String
Dim iFileName As String
Dim i As Long
Dim sSheet As String
Dim xcell As Range
Dim a, b As Integer
MyPath = "C:\as\"
iFileName = Dir(MyPath)
s = 1
On Error Resume Next
Do While iFileName <> ""
Workbooks.Open (MyPath + iFileName)
Windows(iFileName).Activate
For b = 1 To 8
If Workbooks(iFileName).Sheets("1").Cells(b, 1) <> xnone Then
Workbooks("test2").Worksheets("1").Cells(s, 2).Value = Workbooks(iFileName).Sheets("1").Cells(b, 2).Value

s = s + 1
End If
Next b
Workbooks(iFileName).Close savechanges:=True
iFileName = Dir
Loop
End Sub

копирует полностю диапазон ... как сделать что б копировало толька строки по условию <> " "

...

Рейтинг:

0 / 0

05.05.2011, 21:52

| Ответить | Цитировать | Написать

4 сообщений из 4, страница 1 из 1

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / не копирует с одной книги в другую

Читали тему (0):

Читали форум (0):

Пользователи онлайн (0):

start [/forum/topic.php?fid=61&msg=37244247&tid=2176903]:	0ms
get settings:	8ms
get forum list:	12ms
check forum access:	3ms
check topic access:	3ms
track hit:	430ms
get topic data:	7ms
get forum data:	2ms
get page messages:	24ms
get tp. blocked users:	1ms
others:	232ms

total:	722ms

	Необходимые cookie
	Cookie для сбора статистики
	Cookie для маркетинга и рекламы