El código de bucle sigue copiando desde la misma hoja de cálculo de Excel en una carpeta

StackOverflow https://stackoverflow.com//questions/25079506

  •  02-01-2020
  •  | 
  •  

Pregunta

Así que estaba tratando de crear una lista de archivos de Excel en una carpeta (nombre de archivo y ruta) y luego usar un bucle para copiar y pegar una hoja de cálculo específica para todos los archivos enumerados en una hoja de cálculo específica en el Libro de trabajo de Excelque contiene la macro.Hasta el momento todo funciona, excepto el hecho de que el mismo archivo sigue copiado y pegado en lugar de todos los archivos.Los bucles macro para el número correcto de veces, pero no está utilizando todos los archivos de Excel.

aquí es el código:

primera parte para listar los archivos en la carpeta

Private Sub btn_LeaveReport()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("D:\Administration\Time Sheets")
i = 2
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name
    Cells(i + 1, 2) = objFile.Name
    'print file path
    Cells(i + 1, 3) = objFile.Path
    i = i + 1
Next objFile
End Sub

y esta es la parte del bucle

Private Sub btn_PullData()
'Declared Variables
Dim wbk As Workbook
Dim i As Integer
Dim StartAt As Integer
Dim EndAt As Integer
Dim CopyPath As String
Dim CopyPathRow As Integer
Dim iRow As Integer

'Ranges
StartAt = 1
EndAt = Val(ThisWorkbook.Worksheets("LeaveReport").Range("A1"))
CopyPathRow = 3
CopyPath = ThisWorkbook.Worksheets("LeaveReport").Range("C" & CopyPathRow)
iRow = 3

'Loop de loop
For i = StartAt To EndAt
    Application.ScreenUpdating = False
    Set wbk = Workbooks.Open(CopyPath)
    Sheets("TIMESHEET").Select
    Range("C12:S34").Select
    Selection.Copy

    ThisWorkbook.Activate
    Sheets("Pastebin").Select
    Range("a" & iRow).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False

    iRow = iRow + 39
    CopyPathRow = CopyPathRow + 1
    wbk.Close True
Next i

Sheets("Pastebin").Select
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
MsgBox "Timesheet Data Imported"
End Sub

basado en la fuente del error, es decir, el mismo archivo que se usa, supongo que el problema se encuentra con la parte que tiene esto:

COPYPATH= HOWWorkBook.WorkSheets ("Leavereport"). Gama ("C" y copypathrow)

y se "supone" actualizar en el bucle para esto:

copypathrow= copypathrow + 1

¿Fue útil?

Solución

Mover la línea

CopyPath = ThisWorkbook.Worksheets("LeaveReport").Range("C" & CopyPathRow)

Dentro del bucle, ese valor de CopyPath nunca se está cambiando, pero el valor del CopyPathRow es.

Editar: Yo tampoco llamaría a esta recursión.

Licenciado bajo: CC-BY-SA con atribución
No afiliado a StackOverflow
scroll top