How can I
The incomplete macro which works only for specified files and location.
Sub Step1OpenCopyPaste()
Dim oCell As Range
Dim rowCount As Integer
' open the source workbook and select the source sheet
Workbooks.Open Filename:="\e\Rohit\Others\Rahul.xlsx"
Sheets("B2B").Select
' copy the source range
With Sheets("B2B")
rowCount = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(1, 1), .Cells(rowCount, 7)).Select
'Select.range(a7
End With
Selection.Copy
' select current workbook and paste the values starting at A1
Windows("Macro.xlsx").Activate
Sheets("Sheet1").Select
'------------------------------------------------
With Sheets("Sheet1")
Set oCell = .Cells(.Rows.Count, 1).End(xlUp)
End With
oCell.Select
'------------------------------------------------
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
Workbooks.Open Filename:="\\e\Rohit\Others\Rohit.xlsx"
Sheets("B2B").Select
' copy the source range
With Sheets("B2B")
rowCount = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(1, 1), .Cells(rowCount, 7)).Select
End With
Selection.Copy
' select current workbook and paste the values starting at A1
Windows("Macro.xlsx").Activate
Sheets("Sheet1").Select
'------------------------------------------------
With Sheets("Sheet1")
Set oCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
oCell.Select
'------------------------------------------------
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
Dim wb As Workbook
'Loop through each workbook
For Each wb In Application.Workbooks
'Prevent the workbook that contains the
'code from being closed
If wb.Name <> ThisWorkbook.Name Then
'Close the workbook and don't save changes
wb.Close SaveChanges:=False
End If
Next wb
End Sub
It should look something like this:
Dim Filename As String
Dim lLastRow As Long
Dim wbDst As Workbook, wbSrce As Workbook
Dim wsDst As Worksheet
Set wsDst = ThisWorkbook.Worksheets("Sheet1")
Filename = Dir("C:\Users\You\Documents\Test\*.xlsx")
Do While Filename <> ""
Set wbSrce = Workbooks.Open(Filename)
lLastRow = wsDst.UsedRange.Rows.Count + 1
wbSrce.Sheets("B2B").UsedRange.Copy wsDst.Range("A" & lLastRow)
wbSrce.Close savechanges:=False
Filename = Dir
Loop
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.