powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / 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
не копирует с одной книги в другую
    #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
не копирует с одной книги в другую
    #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
не копирует с одной книги в другую
    #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
4 сообщений из 4, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / не копирует с одной книги в другую
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]