Hi Team,
I have the below code to copy the multiple workbooks to single workbook.
In this, every time I need to select the range manually. Cause the range might vary from each work book.
Is there anyway to select the range automatically?
For example, in 1st Workbook, the Range is from A2:O23 and 2nd Workbook, the range is from A2:O45 and goes on..
Please help me. Any amendment in the code pls do it.
As per the below code:
I have a sheetname called "List" and mentioning the start and end range.
I have the below code to copy the multiple workbooks to single workbook.
In this, every time I need to select the range manually. Cause the range might vary from each work book.
Is there anyway to select the range automatically?
For example, in 1st Workbook, the Range is from A2:O23 and 2nd Workbook, the range is from A2:O45 and goes on..
Please help me. Any amendment in the code pls do it.
As per the below code:
I have a sheetname called "List" and mentioning the start and end range.
Code:
Public strFileName As String
Public currentWB As Workbook
Public dataWB As Workbook
Public strCopyRange As String
Sub GetData()
Dim strWhereToCopy As String, strStartCellColName As String
Dim strListSheet As String
strListSheet = "List"
On Error GoTo ErrH
Sheets(strListSheet).Select
Range("B2").Select
'this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
Set currentWB = ActiveWorkbook
GetFileNames
Do While ActiveCell.Value <> ""
strFileName = ActiveCell.Offset(0, 1) & ActiveCell.Value
strCopyRange = ActiveCell.Offset(0, 2) & ":" & ActiveCell.Offset(0, 3)
strWhereToCopy = ActiveCell.Offset(0, 4).Value
strStartCellColName = Mid(ActiveCell.Offset(0, 5), 2, 1)
Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
Set dataWB = ActiveWorkbook
Range(strCopyRange).Select
sbUnMergeRange
Selection.Copy
currentWB.Activate
Sheets(strWhereToCopy).Select
lastRow = LastRowInOneColumn(strStartCellColName)
Cells(lastRow + 1, 1).Select
Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
Selection.Offset(, 15) = Mid(strFileName, 41, 2)
Application.CutCopyMode = False
dataWB.Close False
Sheets(strListSheet).Select
ActiveCell.Offset(1, 0).Select
Loop
Worksheets(ActiveSheet.Index + 1).Select
MoveData
Rows(1).EntireRow.Delete
Rows(1).EntireRow.Delete
Rows(1).EntireRow.Delete
Rows(1).EntireRow.Delete
sbVBS_To_Delete_Multiple_Columns
bic
Exit Sub
ErrH:
MsgBox "It seems some file was missing. The data copy operation is not complete."
Exit Sub
End Sub
Public Function LastRowInOneColumn(col)
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
End With
LastRowInOneColumn = lastRow
End Function
Sub GetFileNames()
Dim sPath As String
Dim sFile As String
Dim iRow As Integer
Dim iCol As Integer
Dim splitFile As Variant
'specify directory to use - must end in "\"
sPath = "U:\Srikanth\PCM\Charges\Next\"
iRow = 1
sFile = Dir(sPath)
Do While sFile <> ""
iRow = iRow + 1
splitFile = Split(sFile, "-")
For iCol = 0 To UBound(splitFile)
Sheet1.Cells(iRow, iCol + 2) = splitFile(iCol)
Next iCol
sFile = Dir ' Get next filename
Loop
End Sub
Sub sbUnMergeRange()
Range("A1:O1000").UnMerge
End Sub
Sub MoveData()
Dim rng As Range
Application.ScreenUpdating = False
On Error Resume Next
Set rng = [J:J].SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rng Is Nothing Then
rng.FormulaR1C1 = "=IF(RC[-1]="""","""",RC[-1])"
[J:J] = [J:J].Value
End If
rng.Offset(0, -1).ClearContents
End Sub
Sub sbVBS_To_Delete_Multiple_Columns()
Columns("Q:AI").EntireColumn.Delete
End Sub
Sub bic()
Dim lRow As Long
Dim SourceRange As Range, DestinationRange As Range, i As Integer
Dim SourceFullRange1 As String, DestFullRange1 As String
Dim strListSheet As String
lRow = Cells(Columns.Count, 16).End(xlUp).Row
SourceFullRange1 = "P2:P" & lRow
Set SourceRange = Sheet2.Range(SourceFullRange1)
DestFullRange1 = "A2:A" & lRow
Set DestinationRange = Sheet2.Range(DestFullRange1)
For i = 1 To lRow
DestinationRange(i, 1).FormulaR1C1 = "=IF(RC[15]=""AT"",""GEBAATWWXXX"",IF(RC[15]=""BG"",""BNPABGSXXXX"",IF(RC[15]=""CZ"",""GEBACZPPXXX"",IF(RC[15]=""DE"",""BNPADEFFXXX"",IF(RC[15]=""DK"",""FTSBDKKKXXX"",IF(RC[15]=""ES"",""BNPAESMMXXX"", IF(RC[15]=""ESF"",""GEBAESMMXXX"",IF(RC[15]=""HU"",""BNPAHUHXXXX"",IF(RC[15]=""IE"",""BNPAIE2DXXX"", IF(RC[15]=""NL"", ""BNPANL2AXXX"", IF(RC[15]=""NO"", ""BNPANOKKXXX"", if(RC[15]=""PL"", ""BNPAPLPXXXX"", IF(RC[15]=""PT"", ""BNPAPTPLXXX"",IF(RC[15]=""RO"", ""FTSBROBUXXX"", ""FTSBSESSXXX""))))))))))))))"
Next i
End Sub