问题
Ok I get to the point where code is reading data from closed workbook and can paste it into sheet2 in that workbook. This is my new code:
Sub Copy456()
Dim iCol As Long
Dim iSht As Long
Dim i As Long
'Fpath = "C:\testy" ' change to your directory
'Fname = Dir(Fpath & "*.xlsx")
Workbooks.Open ("run1.xlsx")
For i = 1 To Worksheets.Count
Worksheets(i).Activate
' Loop through columns
For iSht = 1 To 6 ' no of sheets
For iCol = 1 To 6 ' no of columns
With Worksheets(i).Columns(iCol)
If ((.Cells(1, 1).Value = "Time")) Then ' if first cell=Time then copy two columns
Range(.Cells(1, 2), .End(xlDown)).Select
Selection.Copy Destination:=Workbooks("Your Idea.xlsm").Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1)
Worksheets("Sheet2").Cells(i * 2 + 1) = Worksheets(i).Name
Else
' do nothing
End If
End With
Next iCol
Next iSht
Next i
End Sub
But once I change that part of code:
Selection.Copy Destination:=Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1)
into that code:
Destination:=Workbooks("general.xlsx").Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1)
It stop working issuing error: "subscription is out of range". File general.xlsx is an empty file which is closed as well.
When I change code into:
`Selection.Copy Destination:=Workbooks("Your Idea.xlsm").Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1)
It then issue an error: "1004 cannot change part of merged cell". File "Your Idea.xlsm" is the file from which I running this script.
Any help with this problem?
回答1:
try to avoid merged cells when making spreadsheets as in my humble experience they can come back to bite you. This is how I would roughly go about copying data from one sheet to another you will need to implement your own logic when iterating through and setting the actual ranges you require but it should give you some idea, as I said in my comment be more explicit when setting ranges and avoid magic
.
AFAIK you have to open files in order to manipulate them with VBA
Sub makeCopy()
' turn off features
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' some constants
Const PATH = ""
Const FILE = PATH & "FOO.xls"
' some variables
Dim thisWb, otherWb As Workbook
Dim thisWs, otherWs As Worksheet
Dim i As Integer: i = 0
Dim c As Integer: c = 0
Dim thisRg, otherRg As Range
' some set-up
Set thisWb = Application.ActiveWorkbook
Set otherWb = Application.Workbooks.Open(FILE)
' count the number of worksheets in this workbook
For Each thisWs In thisWb.Worksheets
c = c + 1
Next thisWs
' count the number of worksheets in the other workbook
For Each thisWs In otherWb.Worksheets
i = i + 1
Next thisWs
' add more worksheets if required
If c <= i Then
For c = 1 To i
thisWb.Worksheets.Add
Next c
End If
' reset i and c
i = 0: c = 0
' loop through other workbooks worksheets copying
' their contents into this workbook
For Each otherWs In otherWb.Worksheets
i = i + 1
Set thisWs = thisWb.Worksheets(i)
' ADD YOUR OWN LOGIC FOR SETTING `thisRg` AND
' `otherRg` TO THE APPROPRIATE RANGE
Set thisRg = thisWs.Range("A1: C100")
Set otherRg = otherWs.Range("A1: C100")
otherRg.Copy (thisRg)
Next otherWs
' save this workbook
thisWb.Save
' clean up
Set otherWs = Nothing
otherWb.Close
Set otherWb = Nothing
Set thisWb = Nothing
Set thisWs = Nothing
' restore features
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.Calculate
End Sub
来源:https://stackoverflow.com/questions/9033656/copying-from-closed-workbook-excel-vba