作者:布丁宝宝-_932 | 来源:互联网 | 2023-08-16 19:54
我的编码有2个问题。因为我不是专家,所以请多多包涵。
-
Ws2.range(“ B6:Y”&lrow1).copy-似乎无法按照我想要的方式工作。它仅从B1:Y6复制单元格,但目的是从b6:Y开始复制f到最后一行。
-
Dir Do while仅在一个文件上循环,即使我在指定的文件夹路径上有多个文件也是如此。因此,创建了一个无限循环。
关于我在做什么错的任何想法吗?
Private Sub conso()
Dim folder As String,consofolder As String
Dim files As String,consofile As String
Dim dateyear As String,team As String
Dim strfile As String,newdate As String
Dim wb1 As Workbook,wb2 As Workbook
Dim lrow1 As Long,lrow2 As Long
Dim ws1 As Worksheet,ws2 As Worksheet
dateyear = Range("A2").Value
newdate = Format(dateyear,"mmmm yyyy")
team = Range("B2").Value
folder = Range("C2").Value
cOnsofolder= folder & newdate & "\" & team
cOnsofile= "conso "
files = Dir(consofolder & "\*.xlsm")
strfile = consofolder & "\" & consofile & team & " - " & newdate & ".xlsm"
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Application.AutomatiOnSecurity= msoAutomationSecurityLow
Workbooks.Open Filename:=folder & "\" & "conso conso" & ".xlsm"
Set wb1 = Workbooks("conso conso.xlsm")
wb1.activate
Set ws1 = wb1.Worksheets("Input")
If Len(Dir(strfile)) = 0 Then
GoTo conso
Else
MsgBox "Conso already in place"
Exit Sub
End If
conso:
Do While files <> ""
Debug.Print files
Workbooks.Open Filename:=consofolder & "\" & files
Set wb2 = Workbooks(files)
Set ws2 = wb2.Worksheets("Input")
With wb2
With Worksheets("Input")
lrow1 = .Cells(.Rows.Count,1).End(xlUp).Row
End With
End With
ws2.Range("B6:Y" & lrow1).Copy
wb1.activate
With wb1
With Worksheets("Input")
lrow2 = .Cells(.Rows.Count,1).End(xlUp).Row
End With
End With
ws1.Range("B" & lrow2).PasteSpecial
wb2.Close
files = Dir(consofolder & "\*.xlsm")
Set wb2 = Nothing
Loop
End Sub