VBA 将一个文件夹中多个工作簿的范围复制到另一个文件夹

Question

I have 10 excel files in Folder A. I also have other 10 excel files in Folder B. The 10 files in both folder have the same name. I am trying to copy range A2:B20 of the active worksheet from each of those 10 excel files in Folder A into the other 10 corresponding excel files in Folder B. All files in Folder B only have 1 worksheet named Sheet0. I want to have the range A2:B20 at the end of column A and B of Sheet0 in every excel files in folder B.

Below is my code. I have tried multiple times but it did not work

Sub Copy_range()
    
    Const FolderPath1 = "C:\Users\***\Documents\Folder A\"
    Const FolderPath2 = "C:\Users\***\Documents\Folder B\"
    
    Dim Filename1 As String: Filename1 = Dir(FolderPath1 & "*.csv")
    Dim Filename2 As String: Filename2 = Dir(FolderPath2 & "*.xlsx")
    
    Dim dws As Worksheet: Set dws = Workbooks(Filename2).Worksheets("Sheet0")
    Dim dCell As Range: Set dCell = dws.Cells(dws.Rows.Count, "A1:B").End(xlUp)
    
    Application.ScreenUpdating = False
    Do While Filename1 <> ""
        Set dCell = dCell.Offset(1)
        With Workbooks.Open(Filename1:=FolderPath1 & Filename1, ReadOnly:=True)
            dCell.Value = .ActiveSheet.Range("A2:B20").Value
            .Close False
        End With
        Filename1 = Dir()
    Loop
    Application.ScreenUpdating = True

End Sub

Answer 1

You forgot to open the workbook before trying to set dws to the sheet. Also, your expression to set dCell would cause an error due to "A1:B" not being a valid column input. Finally, the .Offset(1) of dCell will only work on the first iteration. Afterwards, you will want to .Offset(19) because you have pasted in 19 new rows. I have corrected those three issues in the following code:

Sub Copy_range()
    
    Const FolderPath1 = "C:\Users\***\Documents\Folder A\"
    Const FolderPath2 = "C:\Users\***\Documents\Folder B\"
    
    Dim Filename1 As String: Filename1 = Dir(FolderPath1 & "*.csv")
    Dim Filename2 As String: Filename2 = Dir(FolderPath2 & "*.xlsx")
    
    Dim dws As Worksheet
    Dim dCell As Range
    Set dws = Application.Workbooks.Open(FolderPath2 & Filename2).Worksheets("Sheet0")
    Set dCell = dws.Cells(dws.Rows.Count, 1).End(xlUp).Offset(1)
    
    Application.ScreenUpdating = False
    Do While Filename1 <> ""
        With Workbooks.Open(FolderPath1 & Filename1, ReadOnly:=True)
            dCell.Value = .ActiveSheet.Range("A2:B20").Value
            .Close False
        End With
        Filename1 = Dir()
        Set dCell = dCell.Offset(19)
    Loop
    Application.ScreenUpdating = True

End Sub

Truthfully, Offset is not the best way to advance the output range because it can potentially leave a lot of blank rows in your data. It would be better to just re-set dCell with dws.Cells(dws.Rows.Count, 1).End(xlUp).Offset(1)