如何在excel vba中动态选择特定单元格区域?

如何在excel vba中动态选择特定单元格区域?,excel,vba,Excel,Vba,我有一个场景,在这个场景中,我将数据从多个文件复制到主文件,我希望当程序第一次运行时,它应该开始将数据粘贴到主文件中我指定的范围内,该范围工作正常。但当程序再次运行时,它不会从上一个范围开始,而是开始在下一个记录粘贴数据,这是相同数据的重复,我希望当用户第一次或多次运行程序时,程序范围从它第一次运行的同一位置开始。 下面是我的代码 Sub Append() 'Append data from other files Path = "E:\NPM PahseIII\" Dim c As R

我有一个场景,在这个场景中,我将数据从多个文件复制到主文件,我希望当程序第一次运行时,它应该开始将数据粘贴到主文件中我指定的范围内,该范围工作正常。但当程序再次运行时,它不会从上一个范围开始,而是开始在下一个记录粘贴数据,这是相同数据的重复,我希望当用户第一次或多次运行程序时,程序范围从它第一次运行的同一位置开始。 下面是我的代码

Sub Append()
 'Append data from other files
  Path = "E:\NPM PahseIII\"
 Dim c As Range

   'find the second empty cell in ColA
 Set c = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
   'target range for pasting data it first run this is actually pointing to 
   'my desire range but at second or multiple running the range is starting 
    'below at the previous record 
 Set targetcellL = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(2, 1)
 Set targetcellR = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(5, 4)
 Filename = Dir(Path & "*.xlsx")
Do While Filename <> ""
If InStr(Filename, ".") > 0 Then
 Filenamenoext = Left(Filename, InStr(Filename, ".") - 1)
End If
   c.Value = Filenamenoext
   Set c = c.Offset(4, 0)

  Set wb = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
Data = wb.Worksheets(1).Range("B3:E6").Value
wb.Worksheets(1).Range("B3:E6").Copy
ThisWorkbook.Activate
ActiveSheet.Range(targetcellL, targetcellR).Select
  ActiveSheet.Paste
  Set targetcellL = targetcellL.Offset(4, 0)
  Set targetcellR = targetcellR.Offset(5, 0)
Workbooks(Filename).Close
Filename = Dir()
Loop

End Sub
Sub-Append()
'附加来自其他文件的数据
Path=“E:\NPM pahseii\”
调光范围
“找到可乐中的第二个空单元格
Set c=ActiveSheet.Cells(Rows.Count,1)。End(xlUp)。Offset(2,0)
'第一次运行时粘贴数据的目标范围实际上是指向
“我的愿望范围,但在第二次或多次运行时,范围开始
"在上一次记录中,
设置targetcellL=ActiveSheet.Cells(Rows.Count,1).结束(xlUp).偏移量(2,1)
设置targetcellR=ActiveSheet.Cells(Rows.Count,1)。End(xlUp)。Offset(5,4)
Filename=Dir(路径&“*.xlsx”)
文件名“”时执行此操作
如果InStr(文件名“.”>0,则
Filename noext=Left(文件名,InStr(文件名“.”-1)
如果结束
c、 Value=Filenamenoext
设置c=c偏移量(4,0)
设置wb=Workbooks.Open(文件名:=Path&Filename,只读:=True)
数据=wb.工作表(1).范围(“B3:E6”).值
wb.工作表(1).范围(“B3:E6”).副本
此工作簿。激活
ActiveSheet.Range(targetcellL,targetcellR)。选择
活动表。粘贴
设置targetcellL=targetcellL.Offset(4,0)
设置targetcellR=targetcellR.Offset(5,0)
工作簿(文件名)。关闭
Filename=Dir()
环
端接头
问题:我希望当程序运行尽可能多的时间时,它应该开始粘贴数据,并将其粘贴到第一次粘贴数据的范围内。 下面的图片将更准确地解决我的问题。 当程序第一次运行时,我得到粘贴的数据,它低于我想要的范围

第二次运行时,我得到的数据低于范围
我应该怎么做才能使程序运行尽可能多的时间后,数据应该粘贴在第一次运行的范围内,请参见图。

以下是两种不同的方法:


Sub-AppendValuesAndFormats()
'附加来自其他文件的数据
Const Path=“E:\NPM pahseii\”
作为射程的弱小目标
使用ThisWorkbook.ActiveSheet
.UsedRange.Offset(2).ClearContent
设置目标=.Range(“A3”)
以
Filename=Dir(路径&“*.xlsx”)
文件名“”时执行此操作
打开(文件名:=路径和文件名,只读:=真)
target.Value=IIf(InStr(文件名“.”>0,左(文件名,InStr(文件名“.”)-1),“”)
.工作表(1).范围(“B3:E6”).复制目标:=目标.偏移量(0,1)
.Close SaveChanges:=False
以
设置目标=目标偏移量(4)
Filename=Dir()
环
端接头

子附录值()
'附加来自其他文件的数据
Const Path=“E:\NPM pahseii\”
作为射程的弱小目标
使用ThisWorkbook.ActiveSheet
.UsedRange.Offset(2).ClearContent
设置目标=.Range(“A3”)
以
Filename=Dir(路径&“*.xlsx”)
文件名“”时执行此操作
打开(文件名:=路径和文件名,只读:=真)
target.Value=IIf(InStr(文件名“.”>0,左(文件名,InStr(文件名“.”)-1),“”)
target.Range(“B1:E4”).Value=.Worksheets(1).Range(“B3:E6”).Value
.Close SaveChanges:=False
以
设置目标=目标偏移量(4)
Filename=Dir()
环
端接头

这里有两种不同的方法:


Sub-AppendValuesAndFormats()
'附加来自其他文件的数据
Const Path=“E:\NPM pahseii\”
作为射程的弱小目标
使用ThisWorkbook.ActiveSheet
.UsedRange.Offset(2).ClearContent
设置目标=.Range(“A3”)
以
Filename=Dir(路径&“*.xlsx”)
文件名“”时执行此操作
打开(文件名:=路径和文件名,只读:=真)
target.Value=IIf(InStr(文件名“.”>0,左(文件名,InStr(文件名“.”)-1),“”)
.工作表(1).范围(“B3:E6”).复制目标:=目标.偏移量(0,1)
.Close SaveChanges:=False
以
设置目标=目标偏移量(4)
Filename=Dir()
环
端接头

子附录值()
'附加来自其他文件的数据
Const Path=“E:\NPM pahseii\”
作为射程的弱小目标
使用ThisWorkbook.ActiveSheet
.UsedRange.Offset(2).ClearContent
设置目标=.Range(“A3”)
以
Filename=Dir(路径&“*.xlsx”)
文件名“”时执行此操作
打开(文件名:=路径和文件名,只读:=真)
target.Value=IIf(InStr(文件名“.”>0,左(文件名,InStr(文件名“.”)-1),“”)
target.Range(“B1:E4”).Value=.Worksheets(1).Range(“B3:E6”).Value
.Close SaveChanges:=False
以
设置目标=目标偏移量(4)
Filename=Dir()
环
端接头

我想这样做并没有得到我想要的结果,它开始将数据粘贴到第二列,但第二次运行程序也是这样做的,我的情况是,当程序第一次运行时,我将数据粘贴到我想要的位置,但第二次我希望我的范围从与第一次相同的位置开始,请参见上面的pic 1,我始终希望将数据粘贴到该范围,无论程序是否运行了同样多的时间。您可以在开始程序之前清除该范围或者初始化
c=Range(“A3”)
targetcellL=Range(“B3”)
。我强烈建议您观看此视频:确保并使用
@
将评论中的某个人作为目标。我认为您这样做并没有达到我的目的,而是开始将数据粘贴到第二列b
Sub AppendValuesAndFormats()
'Append data from other files
    Const Path = "E:\NPM PahseIII\"
    Dim target As Range

    With ThisWorkbook.ActiveSheet
        .UsedRange.Offset(2).ClearContents
        Set target = .Range("A3")
    End With

    Filename = Dir(Path & "*.xlsx")

    Do While Filename <> ""
        With Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
            target.Value = IIf(InStr(Filename, ".") > 0, Left(Filename, InStr(Filename, ".") - 1), "")
            .Worksheets(1).Range("B3:E6").Copy Destination:=target.Offset(0, 1)
            .Close SaveChanges:=False
        End With
        Set target = target.Offset(4)
        Filename = Dir()
    Loop

End Sub
Sub AppendValues()
'Append data from other files
    Const Path = "E:\NPM PahseIII\"
    Dim target As Range

    With ThisWorkbook.ActiveSheet
        .UsedRange.Offset(2).ClearContents
        Set target = .Range("A3")
    End With

    Filename = Dir(Path & "*.xlsx")
    Do While Filename <> ""
        With Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
            target.Value = IIf(InStr(Filename, ".") > 0, Left(Filename, InStr(Filename, ".") - 1), "")
            target.Range("B1:E4").Value = .Worksheets(1).Range("B3:E6").Value
            .Close SaveChanges:=False
        End With
        Set target = target.Offset(4)
        Filename = Dir()
    Loop

End Sub