Luis Diaz
asked on
VBA: copy range dynamically based on config sheet v2
Hello experts,
I use the following procedure in order to copy range dynamically based on a config sheet:
Hello experts,
I use the following procedure in order to copy specific range from one sheet to another based on the loop of a config sheet.
I would like to re-adapat the procedure in order to cover the following requirement:
Instead of reporting column the the procedure should take into account the Header Name and start rows reported in the config sheet:
-SourceSheet: is the reference sheet in which is located the range to copy.
-SourceHeaderRange is the value field related to the range that should be copy.
-SourceHeaderRow is the row number in which is located the SourceHeaderRange this will also indicate from which range should be copied the reference range. If SourceHeaderRow = 1 then the range should be copied as row 2.
-DestinationSheet is the reference sheet in which is located the range to paste.
-DestinationHeaderRange will indicate in which column will be pasted paste the source range.
DestinationHeaderRow will indicate where is located the DestinationHeaderRange.
If DestinationHeaderRow = 1 the Range to paste to paste should be paste as of row 2.
Elements to take into account.
-DestinationRange should be clear without the header before the copy process
-If SourceSheet and DestinationSheet don’t exist omit line.
-If SourceHeaderRow, DestinationHeaderRow are numeric omit line.
-If SourceHeaderRange and DestinationHeaderRange don’t exist omit line.
-If SourceHeaderRange and DestinationHeaderRange exist multiple times in the related sheets omit line.
I attached dummy file with example.
If you have questions, please contact me.
CopyPasteRangeDynamically.xlsm
2017-02-10-18_08_28-Microsoft-Excel-.png
I use the following procedure in order to copy range dynamically based on a config sheet:
Sub CopyRangeDynamically()
Dim wsConfig As Worksheet, wsDestination As Worksheet, wsSourceSheet As Worksheet
Dim sSheetName As String, sSourceColumn As String, sSourceColumn2 As String, sDestinationColumn, sSheetName2 As String
Dim rgDestination As Range, rgSource As Range
Dim rw As Integer, MaxRowSourceSheet As Long
CheckConfigSheet
Set wsConfig = Worksheets("Config")
Application.ScreenUpdating = False
For rw = 2 To wsConfig.Range("A1").CurrentRegion.Rows.Count
sSheetName = wsConfig.Range("A" & rw) '==Original Sheet Name
Set wsSourceSheet = Worksheets(sSheetName)
sSheetName2 = wsConfig.Range("D" & rw) '==Destination Sheet Name
Set wsDestination = Worksheets(sSheetName2)
MaxRowSourceSheet = wsSourceSheet.Cells.SpecialCells(xlCellTypeLastCell).Row '==Max Row Original Sheet
sSourceColumn = wsConfig.Range("B" & rw)
sSourceColumn2 = wsConfig.Range("C" & rw)
sDestinationColumn = wsConfig.Range("E" & rw)
sDestinationHeader = wsConfig.Range("F" & rw)
'MatchCount = 0
'wsSourceSheet.Select
Set rgSource = wsSourceSheet.Range(sSourceColumn & "2:" & sSourceColumn2 & MaxRowSourceSheet)
Set rgDestination = wsDestination.Range(sDestinationColumn & "2")
rgSource.Copy
rgDestination.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False ' to clear the clipboard
wsDestination.Range(sDestinationColumn & "1").Value = sDestinationHeader
MsgBox "Done", vbOKOnly 'just as an FYI to the user and pass back control
Next
wsConfig.Select
End Sub
Sub CheckConfigSheet()
Dim wsConfig As Worksheet, ws As Worksheet, rw As Integer, col As Integer, i As Integer, WarningText As String
Set wsConfig = Worksheets("Config")
For rw = 2 To wsConfig.Range("A1").CurrentRegion.Rows.Count
i = 0
For Each ws In Worksheets
If wsConfig.Range("A" & rw) <> "" Then
If UCase(ws.Name) = UCase(wsConfig.Range("A" & rw)) Then
i = i + 1
End If
If UCase(ws.Name) = UCase(wsConfig.Range("D" & rw)) Then
i = i + 1
End If
End If
Next ws
For col = 2 To 3
If wsConfig.Cells(rw, col) <> "" And Len(wsConfig.Cells(rw, col)) <= 2 Then
If WorksheetFunction.IsText(wsConfig.Cells(rw, col)) Then
i = i + 1
End If
End If
Next col
If wsConfig.Cells(rw, col) <> "" And Len(wsConfig.Cells(rw, col)) <= 2 Then
If WorksheetFunction.IsText(wsConfig.Cells(rw, 4)) Then
i = i + 1
End If
End If
'If wsConfig.Range("G" & rw) = 0 Or wsConfig.Range("G" & rw) = 1 Then
'i = i + 1
'End If
If i <> 4 Then
WarningText = "Warning" & Chr(10) & "Data entered in Config Sheet row " & CStr(rw) & " is not consistent, please check that:"
WarningText = WarningText & Chr(10) & "1-Sheets exist or there is a misspelled mistake or you haven't entered data."
WarningText = WarningText & Chr(10) & "2-Required columns entered in Range are alphabetical and not numeric."
WarningText = WarningText & Chr(10) & "3-Required flag value is not 0 or 1"
WarningText = WarningText & Chr(10) & Chr(10) & "Program stop"
MsgBox WarningText, vbCritical
End
End If
Next rw
End Sub
Hello experts,
I use the following procedure in order to copy specific range from one sheet to another based on the loop of a config sheet.
I would like to re-adapat the procedure in order to cover the following requirement:
Instead of reporting column the the procedure should take into account the Header Name and start rows reported in the config sheet:
-SourceSheet: is the reference sheet in which is located the range to copy.
-SourceHeaderRange is the value field related to the range that should be copy.
-SourceHeaderRow is the row number in which is located the SourceHeaderRange this will also indicate from which range should be copied the reference range. If SourceHeaderRow = 1 then the range should be copied as row 2.
-DestinationSheet is the reference sheet in which is located the range to paste.
-DestinationHeaderRange will indicate in which column will be pasted paste the source range.
DestinationHeaderRow will indicate where is located the DestinationHeaderRange.
If DestinationHeaderRow = 1 the Range to paste to paste should be paste as of row 2.
Elements to take into account.
-DestinationRange should be clear without the header before the copy process
-If SourceSheet and DestinationSheet don’t exist omit line.
-If SourceHeaderRow, DestinationHeaderRow are numeric omit line.
-If SourceHeaderRange and DestinationHeaderRange don’t exist omit line.
-If SourceHeaderRange and DestinationHeaderRange exist multiple times in the related sheets omit line.
I attached dummy file with example.
If you have questions, please contact me.
CopyPasteRangeDynamically.xlsm
2017-02-10-18_08_28-Microsoft-Excel-.png
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Tested and it works. Thank you again for your help!
ASKER